vba copy data every 10 minutes

[ste33uka]

I use the follwing vba to auto copy data from cells to cells every ten 10 minutes.
It runs for 70 sheets.
i have just added the 1st 2 sheets as an example.

Would there be anyway to make it copy faster ?
Would adding code in vba "if cell has value over >0" make it faster? , as some cells dont have data all the time.
Would anyone have an example how to add " if cell is over >0" ?
Thanks

Sub copytenminutes()
     Sheet1.Range("cd1").Value = Sheet1.Range("F5").Value
     Sheet1.Range("ce1").Value = Sheet1.Range("f6").Value
     Sheet1.Range("cf1").Value = Sheet1.Range("F7").Value
     Sheet1.Range("cg1").Value = Sheet1.Range("f8").Value
     Sheet1.Range("ch1").Value = Sheet1.Range("F9").Value
     Sheet1.Range("ci1").Value = Sheet1.Range("f10").Value
     Sheet1.Range("cj1").Value = Sheet1.Range("F11").Value
     Sheet1.Range("ck1").Value = Sheet1.Range("f12").Value
     Sheet1.Range("cl1").Value = Sheet1.Range("F13").Value
     Sheet1.Range("cm1").Value = Sheet1.Range("f14").Value
     Sheet1.Range("cn1").Value = Sheet1.Range("F15").Value
     Sheet1.Range("co1").Value = Sheet1.Range("f16").Value
     Sheet1.Range("cp1").Value = Sheet1.Range("F17").Value
     Sheet1.Range("cq1").Value = Sheet1.Range("f18").Value
     Sheet1.Range("cr1").Value = Sheet1.Range("F19").Value
    
     Sheet2.Range("cd1").Value = Sheet2.Range("F5").Value
     Sheet2.Range("ce1").Value = Sheet2.Range("f6").Value
     Sheet2.Range("cf1").Value = Sheet2.Range("F7").Value
     Sheet2.Range("cg1").Value = Sheet2.Range("f8").Value
     Sheet2.Range("ch1").Value = Sheet2.Range("F9").Value
     Sheet2.Range("ci1").Value = Sheet2.Range("f10").Value
     Sheet2.Range("cj1").Value = Sheet2.Range("F11").Value
     Sheet2.Range("ck1").Value = Sheet2.Range("f12").Value
     Sheet2.Range("cl1").Value = Sheet2.Range("F13").Value
     Sheet2.Range("cm1").Value = Sheet2.Range("f14").Value
     Sheet2.Range("cn1").Value = Sheet2.Range("F15").Value
     Sheet2.Range("co1").Value = Sheet2.Range("f16").Value
     Sheet2.Range("cp1").Value = Sheet2.Range("F17").Value
     Sheet2.Range("cq1").Value = Sheet2.Range("f18").Value
     Sheet2.Range("cr1").Value = Sheet2.Range("F19").Value

     Application.OnTime Now + TimeValue("00:10:00"), "copytenminutes"


End Sub

 

[ste33uka]

i get error = cant execute code in the break mode ?
edit seems to be working now
Thanks alot rollis, appreciate it.

Sub threemin()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  

With Sheet1
    lr = .Range("CD" & .Rows.Count).End(xlUp).Row + 1 'last used row +1
    .Range("CD" & lr & ":CR" & lr).Value = Application.Transpose(.Range("F5:F19").Value)
End With

With Sheet2
    lr = .Range("CD" & .Rows.Count).End(xlUp).Row + 1 'last used row +1
    .Range("CD" & lr & ":CR" & lr).Value = Application.Transpose(.Range("F5:F19").Value)
End With




  
    Application.OnTime Now + TimeValue("00:3:00"), "threemin"

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

 

[rollis13]

Since you have 70 sheets to update, did you consider my suggestion in post #4 ?