Automatically copy cells value and paste into next available empty cell

786javed

New Member
Joined
Jun 2, 2013
Messages
18
Hi,
Cell range in Sheet1 -- A1 : A15 updates value with forex rate every minute, linked with a DDE external data link.
.
Need to copy each cell value and paste into Sheet2 rows starting from A1:A15 next available empty cell every 5 minutes.
.
Example:
Sheet1/A1 value should be copy/paste to Sheet2/A1,B1,C1,D1 .... continue same row with 5 minutes (time interval may be change)
Sheet1/A2 value should be copy/paste to Sheet2/A1,B2,C2,D1 .... continue same row with time interval define.
.
Any macro for excel 2007 will be great help.
.
Regards,
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Right click on Sheet1 tab and choose "View Code" then insert the following:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A1:A15")) Is Nothing Then
For Each Cell In Range("A1:A15")
    Cell.Copy
    If Sheets("Sheeet2").Range("A" & Cell.Row).Value = "" Then
       Sheets("Sheeet2").Range("A" & Cell.Row).PasteSpecial
    Else
       Sheets("Sheeet2").Cells(Cell.Row, Sheets("Sheeet2").Cells(Cell.Row, Columns.Count). _
       End(xlToLeft).Column + 1).PasteSpecial
    End If
Next
Else
Exit Sub
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Hope this works as expected!
ZAX
 
Last edited:
Upvote 0
hi ZAX,

Appreciate your quick reply.
can you tell me where the time interval is define in this code?
 
Upvote 0
Looks like the time interval will be each worksheet_change that occurs with in the range("A1:A15").

Maybe that is too often for you, but you did say... "(time interval may be change)".

Regards,
Howard
 
Upvote 0
hi Howard,
.
you are right data change in sheet1/A1:A15 very frequently, sometime every second or 10 seconds, a minute depends on time of the day.
.
I just want to copy the data every 5 minutes if we can define in macro, or 10 minutes i can change in macro.
.
i tried to manually change the data and getting error:
Error #1:
.
Run-time error g:
Subscript out of range.
.
appreciate your time.
.
regards,
 
Upvote 0
Try this. Note the macro name changes in red, adapt to your names

Rich (BB code):
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.OnTime Now + TimeValue("00:05:00"), "TheNameOfMySub"
End Sub

Sub TheNameOfMySub()
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A1:A15")) Is Nothing Then
For Each Cell In Range("A1:A15")
Cell.Copy
If Sheets("Sheeet2").Range("A" & Cell.Row).Value = "" Then
Sheets("Sheeet2").Range("A" & Cell.Row).PasteSpecial
Else
Sheets("Sheeet2").Cells(Cell.Row, Sheets("Sheeet2").Cells(Cell.Row, Columns.Count). _
End(xlToLeft).Column + 1).PasteSpecial
End If
Next
Else
Exit Sub
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards,
Howard
 
Upvote 0
My code doesn't work according to time, It works each time a change happens in the range, But enter the following codes in an ordinary module and run the CopyEachFiveMinutes macro to copy each five minutes.....
(My apologies, I changed the references in the first code to fit to my Test workbook so I put Sheeet2 instead of Sheet2....Hope you noticed)
Code:
Sub CopyEachFiveMinutes()
Application.ScreenUpdating = False
Do
Application.OnTime DateAdd("s", 300, Now), "Copy"
Loop
Application.ScreenUpdating = True
End Sub

Sub Copy()
For Each Cell In Range("A1:A15")
    Cell.Copy
    If Sheets("Sheet2").Range("A" & Cell.Row).Value = "" Then
       Sheets("Sheet2").Range("A" & Cell.Row).PasteSpecial
    Else
       Sheets("Sheet2").Cells(Cell.Row, Sheets("Sheet2").Cells(Cell.Row, Columns.Count). _
       End(xlToLeft).Column + 1).PasteSpecial
    End If
Next
End Sub
ZAX
 
Last edited:
Upvote 0
Try this. Note the macro name changes in red, adapt to your names

Rich (BB code):
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.OnTime Now + TimeValue("00:05:00"), "TheNameOfMySub"
End Sub

Sub TheNameOfMySub()
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A1:A15")) Is Nothing Then
For Each Cell In Range("A1:A15")
Cell.Copy
If Sheets("Sheeet2").Range("A" & Cell.Row).Value = "" Then
Sheets("Sheeet2").Range("A" & Cell.Row).PasteSpecial
Else
Sheets("Sheeet2").Cells(Cell.Row, Sheets("Sheeet2").Cells(Cell.Row, Columns.Count). _
End(xlToLeft).Column + 1).PasteSpecial
End If
Next
Else
Exit Sub
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards,
Howard

Ummm, I think you copied the macro with the Sheeet2 thing, Again hope the OP notices.
 
Upvote 0
I think so too. I just assumed the code was working and was looking for a run-time solution.

The OP did mention an out of subscript range error, so if the OP reads all the responses, will most likely pick up on it.

Regards,
Howard
 
Upvote 0
Try this. Note the macro name changes in red, adapt to your names

Rich (BB code):
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.OnTime Now + TimeValue("00:05:00"), "TheNameOfMySub"
End Sub

Sub TheNameOfMySub()
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A1:A15")) Is Nothing Then
For Each Cell In Range("A1:A15")
Cell.Copy
If Sheets("Sheet2").Range("A" & Cell.Row).Value = "" Then
Sheets("Sheet2").Range("A" & Cell.Row).PasteSpecial
Else
Sheets("Sheet2").Cells(Cell.Row, Sheets("Sheet2").Cells(Cell.Row, Columns.Count). _
End(xlToLeft).Column + 1).PasteSpecial
End If
Next
Else
Exit Sub
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards,
Howard

Hi,
sorry guys,
i tried and getting compile error "Variable not define" pls see the with blue word Target.
.
i m sorry i am not a tech guy in macros. appreciate your help.

regards,
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

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
Back
Top