Copy and update a column every minute

[henryvii99]

I had found a code which can copy a cell in A1 to B2, C2, D2... every time when Cell A1 updates. Here's the code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Range("B" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("A1").Value
    End If
End Sub

Now I want to do something similar: I want to copy a range of cells D4:D322 to column L4:L322, then M4:M322, then N4:N322 etc.

I would like to seek help from you, thanks in advance!

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Long
If Not Intersect(Target, Range("D322")) Is Nothing Then
    Application.EnableEvents = False
    LC = Cells(4, Columns.Count).End(xlToLeft).Column + 1
    Range("D4:D322").Copy Destination = Cells(4, LC)
    Application.EnableEvents = True
End If
End Sub

 

[henryvii99]

Thanks for your kind help!

But I got a error message after I copy the data. It said something wrong with the copy direction.

 

[henryvii99]

The error message is:

error 1004, copy method of range class failed

 

[VoG]

Sorry, missing a :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Long
If Not Intersect(Target, Range("D322")) Is Nothing Then
    Application.EnableEvents = False
    LC = Cells(4, Columns.Count).End(xlToLeft).Column + 1
    Range("D4:D322").Copy Destination:=Cells(4, LC)
    Application.EnableEvents = True
End If
End Sub

Try amending the code. Save your workbook, close Excel, try again.

 

[henryvii99]

Thanks! It worked perfectly and it is compatible with the autoupdate.
Thanks for your kind help!

I would like to ask one more question: I want to delete the first downloaded range (i.e.L4:L322) after getting 30 entries, in one of the example, they delete the cell value B1 and shift other values upwards.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR as Long
If Not Intersect(Target, Range("A1")) Is Nothing Then
   NR = Range("B" & Cells(Rows.Count).Row).End(xlUp).Row + 1
   Range"("B" & NR).Value = Range("A1").Value
   If NR > 30 Then Range("B1").Delete xlShiftUp
End If
End Sub

Thanks in advance! You are very kind!

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Long
If Not Intersect(Target, Range("D322")) Is Nothing Then
    Application.EnableEvents = False
    LC = Cells(4, Columns.Count).End(xlToLeft).Column + 1
    If LC > 41 Then
        Range("L4:L322").Delete shift:=xlShiftToLeft
        LC = 41
    End If
    Range("D4:D322").Copy Destination:=Cells(4, LC)
    Application.EnableEvents = True
End If
End Sub

 

[henryvii99]

That's a perfect macro! Thanks for your king help!