vba copy data every 10 minutes

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
358
Office Version
  1. 2019
Platform
  1. Windows
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

VBA Code:
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
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

rollis13

Active Member
Joined
Jul 30, 2012
Messages
414
Office Version
  1. 2016
Platform
  1. Windows
Try adding at the begining of the macro:
Application.ScreenUpdating = False
and at the bottom just before Application.OnTime:
Application.ScreenUpdating = True
it may help.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Try ...

VBA Code:
Sub copytenminutes()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With Sheet1
        .Range("cd1:cr1").Value = Application.Transpose(.Range("f5:f19").Value)
    End With
    With Sheet2
        .Range("cd1:cr1").Value = Application.Transpose(.Range("f5:f19").Value)
    End With

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

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
 
Solution

rollis13

Active Member
Joined
Jul 30, 2012
Messages
414
Office Version
  1. 2016
Platform
  1. Windows
Since the sheets are 70 I would suggest changing these lines of code to something like this:
VBA Code:
For Each Sht In Worksheets
    'if necessary add here exception/s with If/Then <> "Sheetname/s"
    With Sht
        .Range("CD1:CR1").Value = Application.Transpose(.Range("F5:F19").Value)
    End With
Next Sht
 

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
358
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thanks for all suggestions ,
and thanks gwteb, your suggestion made it super dooper fast.

 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
You are welcome!
Glad we could help and thanks for letting us know.
 

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
358
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

You are welcome!
Glad we could help and thanks for letting us know.
one more thing, i see what transpose does now, how would i auto copy ("f5:f19") to ("h5:h19"). ?
 

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
358
Office Version
  1. 2019
Platform
  1. Windows
i worked it out. all done here
 

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
358
Office Version
  1. 2019
Platform
  1. Windows
Thanks for all suggestions ,
and thanks gwteb, your suggestion made it super dooper fast.

How could i change code so that it pastes on next available row ?
So it would paste on row 1 cd1:cr1 then row 2 cd2:cr2 and ond so on ?

VBA Code:
        Sub copytenminutes()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheet1
.Range("cd1:cr1").Value = Application.Transpose(.Range("f5:f19").Value)
End With
With Sheet2
.Range("cd1:cr1").Value = Application.Transpose(.Range("f5:f19").Value)
End With

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

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
 

rollis13

Active Member
Joined
Jul 30, 2012
Messages
414
Office Version
  1. 2016
Platform
  1. Windows
Something like this will do the trick:
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,009
Messages
5,622,145
Members
415,881
Latest member
tasic89

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top