Copy and paste range ontime
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 ? |
Copy and paste range ontime
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, Procedu=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, Procedu=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 |
Copy and paste range ontime
"Dave Peterson" wrote: 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, Procedu=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, Procedu=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 . Thank you Dave. |
All times are GMT +1. The time now is 10:15 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com