检测到更改时将范围复制到另一个 Sheet 的下一行

Question

我正在编写一个 VBA 脚本，该脚本监视某个范围 ("A4:Q4") 的变化，因为该范围使用 "RTD" 函数并且大约每秒刷新一次。一旦它检测到该范围内的一个值发生变化，我希望它将该范围复制到一个新的 sheet，并粘贴到下一个可用行中。

我试过下面的代码，但目前它所做的只是替换 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

        ' 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

我实际上只想将所有更改记录到 sheet2 中，在更改发生时将范围复制到下一个可用的空行。最好将其分配给一个按钮，单击一次将启动记录器，再单击一次将停止它，而不是在工作簿打开时自动启动，但现在的方式也可以。

谢谢！！

更新：

我尝试改用此代码，但它仍然没有向 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

只是在 Sheet2 中没有正确偏移！啊！

Answer 1

您需要将 NextRow 放在 With 语句中，以确保获得正确的行数。

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

检测到更改时将范围复制到另一个 Sheet 的下一行

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

excel

vba

excel-2016