I've never set up 370 different ontime routines and I'm not sure how excel will
react.
Instead, I'd use a single ontime procedure that instructs itself to run once
more in a minute.
This is based on Chip Pearson's OnTime instructions:
http://www.cpearson.com/Excel/OnTime.aspx
(Untested, but it did compile)
Option Explicit
Public RunWhen As Double
Public Const cRunWhat = "DoTheCopy" ' the name of the procedure to run
Dim DestCell As Range
Dim sCtr As Long
Dim WhichSheet As Range
Sub StartTimer()
If WhichSheet Is Nothing Then
'initialize the variables
Set WhichSheet = ThisWorkbook.Worksheets("sheet1")
Set DestCell = WhichSheet.Range("c2")
sCtr = 1
RunWhen = Now + TimeSerial(14, 7, 0)
End If
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
Sub TheSub()
With WhichSheet
.Range("C2:C4").Copy
DestCell.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
'get ready for next time
If sCtr <= 370 Then
sCtr = sCtr + 1
RunWhen = RunWhen + TimeSerial(0, 1, 0)
Set DestCell = DestCell.Offset(0, 1)
StartTimer ' Reschedule the procedure
End If
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=False
End Sub
Rob wrote:
>
> Hi,
> I need to copy a static range and paste to specific cells at specific times.
> The time interval is over 370 minutes. Here is the code that seems to work
> well.
>
> Sub CopyVolume1()
> Range("C2:C4").Select
> Selection.Copy
> Range("D2").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> End Sub
>
> Public Sub Time()
> Application.OnTime TimeValue("14:07:00"), "CopyVolume1"
> Application.OnTime TimeValue("14:08:00"), "CopyVolume2"
> Application.OnTime TimeValue("14:09:00"), "CopyVolume3"
> End Sub
>
> Sub CopyVolume2()
> Range("C2:C4").Select
> Selection.Copy
> Range("e2").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> End Sub
>
> Sub CopyVolume3()
> Range("C2:C4").Select
> Selection.Copy
> Range("f2").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> End Sub
>
> Is there a way to do this with out having to copy and paste the Sub
> CopyVolume3
> until I have 370 Sub CopyVolumes and 370 Application.OnTime
> TimeValue("14:09:00"), "CopyVolume3". Each time having to enter the various
> parameters ?
--
Dave Peterson
Similar Threads
