我正在研究一个VBA脚本,该脚本监视某个范围(“ A4:Q4”)的更改,因为该范围使用“ RTD”功能并每秒刷新一次。一旦它检测到该范围内的一个值发生更改,我希望它将该范围复制到新的工作表上,然后粘贴到下一个可用行中。
我尝试下面的代码,但是当前所做的只是替换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中只是无法正确偏移!啊!
答案 0 :(得分: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