VBA that does copy paste every 15 minutes

[Bill R]

I would like VBA to copy A1.B1 values to A2.B2 at 8:00am, then copy A1.B1 values to A3.B3 at 8:15am and so on until 4 pm. I don't know how to do VBA, but I'm trying to learn it. Thank you.

 

[Fishboy]

I would like VBA to copy A1.B1 values to A2.B2 at 8:00am, then copy A1.B1 values to A3.B3 at 8:15am and so on until 4 pm. I don't know how to do VBA, but I'm trying to learn it. Thank you.

Hi Bill, welcome to the boards.

Ok, this may not be the best way of doing things, but seeing as nobody else has replied this may well be your best shot for the time being.

Right, so this method involves 2 macros and a workbook_open event. Let's start with the workbook_open event first:

- Go to the VBA developer window, locate your document in the project window on the left, then right-click on ThisWorkbook and select View Code.
- Paste in the following code

Private Sub Workbook_Open()
' At set time runs "Copy_A1B1" macro
Application.OnTime TimeValue("08:00"), "Copy_A1B1"
End Sub

Next we will deal with the 2 macros.

- Go to the VBA developer window, locate your document in the project window on the left, then right-click on ThisWorkbook and select Import>Module
- Paste in the following 2 macros

Sub Copy_A1B1()
' Sets screen updating to false to prevent screen flicker
Application.ScreenUpdating = False
' Select Sheet1 cells A1 and B1 and copy
Worksheets("Sheet1").Range("A1:B1").Copy
' Find the next empty row based on column A
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
' Paste the copied data
ActiveSheet.Paste
' Call the "TimerReset" macro
Call TimerReset
' Save the workbook
ActiveWorkbook.Save
End Sub

Sub TimerReset()
' Instructs Excel to run "Copy_A1B1" macro again in 15 minutes
Application.OnTime Now + TimeValue("00:15:00"), "Copy_A1B1"
End Sub

So what does the above actually do?

The workbook open event tells Excel that at 08:00 it needs to run the "Copy_A1B1" macro.
The "Copy_A1B1" macro copies cells A1 and B1 to the next free row, then calls the "TimerReset" macro.
The "TimerReset" macro tells Excel to run "Copy_A1B1" again in 15 minutes.
This process then obviously loops every 15 minutes.

I hope this helps or at least gets you going in the right direction.

 

[Fishboy]

Don't forget you may need to amend the sheet name in the "Copy_A1B1" macro to suit your data (now highlighted in red as a reminder)

Sub Copy_A1B1()
' Sets screen updating to false to prevent screen flicker
Application.ScreenUpdating = False
' Select Sheet1 cells A1 and B1 and copy
Worksheets("Sheet1").Range("A1:B1").Copy
' Find the next empty row based on column A
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
' Paste the copied data
ActiveSheet.Paste
' Call the "TimerReset" macro
Call TimerReset
' Save the workbook
ActiveWorkbook.Save
End Sub

 

[Kuljack]

An alternative route, this is a looping macro that will just run forever till the metrics are met.

My advice, open an MS Excel session with this and start the run. Minimize the workbook, and open a separate session of MS if you need to do other things in Excel.

Sub CopyOverTest()

Dim Time As Date
Dim Break As Date
Dim x As Integer
Dim Add As Date



Time = Format(Now(), "HH:MM")
Break = Format("08:00", "HH:MM")
Add = Format("00:15", "HH:MM")
x = 1

    Do Until Time >= "4:00:00 PM"
        If Time = Break Then
            Range(Cells(x, "A"), Cells(x, "B")).Copy
            x = x + 1
            Range(Cells(x, "A"), Cells(x, "B")).Select
            ActiveSheet.Paste
            Break = Break + Add
        Else
        End If
        Time = Format(Now(), "HH:MM")
    Loop


End Sub

 

[Fishboy]

    Do Until Time >= "4:00:00 PM"

Whoops! I totally forgot about that part!

 

[Bill R]

Thank you Fishboy and Kuljack for responding!!!!!!!! I just checked the board, so I haven't tried your VBA, but wow, you guys put some effort into this. Thanks again!