CODEWITHSUNDEEP
excelvbaexcel-2016
wildcat89
wildcat89

Reputation: 1285

Copy Range to Another Sheet's Next Row When a Change is Detected

I am working on a VBA script that monitors a certain range ("A4:Q4") for changes as this range uses the "RTD" function and refreshes every second or so. Once it detects that one of the values in that range changes, I want it to copy that range over to a new sheet, and paste in the next available row.

I have tried to below code, but currently all it does is replace the current line in Sheet2 (the destination), it does not add it to the next available row.

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Worksheets("Sheet1").Range("A4:Q4")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
        ' MsgBox "Cell " & Target.Address & " has changed."

        'find next free cell in destination sheet
        Dim NextFreeCell As Range
        Set NextFreeCell = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)

        'copy & paste. Yes, I also want R4 to copy over
        Worksheets("Sheet1").Range("A4:R4").Copy
        NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False


    End If

End Sub

I effectively just want to end up with a log of all the changes into sheet2, copying the range to next available empty row as changes happen. It would be nice to have this assigned to a button where one click would start the logger and another click would stop it, rather than just automatically starting when the workbook is open, but the way it is now is ok too.

Thanks!!

UPDATE:

I've tried adapting to use this code instead, but it's still not adding a new row to Sheet2:

    Private Sub Worksheet_Change(ByVal Target As Range)


    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Worksheets("Sheet1").Range("A4:Q4")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then


    Dim NextRow As Range
    Set NextRow = Range("A" & Sheets("Sheet2").UsedRange.Rows.Count + 1)
    Sheet1.Range("A4:R4").Copy
    Sheet2.Activate
    NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
    Application.CutCopyMode = False
    Set NextRow = Nothing

    End If

End Sub

It's just not offsetting properly in Sheet2! Ah!

Upvotes: 1

Views: 176

Answers (1)

GMalc
GMalc

Reputation: 2628

You need to place your NextRow inside a With statement to ensure you get the correct row count.

Sheet1.Range("A4:R4").Copy

With Sheets("Sheet2")
Dim NextRow As Range
Set NextRow = .Range("A" &  .UsedRange.Rows.Count + 1)

    NextRow.PasteSpecial Paste:=xlValues, Transpose:=False

Application.CutCopyMode = False
End With

Upvotes: 2

Related Questions