Я работаю над сценарием 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
Фактически я просто хочу получить журнал всех изменений в листе2, копируя диапазон в следующую доступную пустую строку по мере того, как происходят изменения. Было бы неплохо, чтобы это было назначено кнопке, где один щелчок запускал бы регистратор, а другой останавливал бы его, а не просто автоматически запускал, когда рабочая книга открыта, но то, как это сейчас, тоже нормально.
Спасибо!!
Обновлено:
Я попытался адаптироваться к использованию этого кода, но он все еще не добавляет новую строку в 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! Ах!
Cells(Rows.Count
Я могу подумать, что вам также нужно подтвердить rows.count на листе 2
@SJR Да, в Sheet1.A4 есть значение, и оно отслеживает весь диапазон, поэтому, если какое-либо значение ячейки изменяется в диапазоне, оно должно копироваться
Ваш код работает для меня. Является ли «Лист2» определенно правильным листом?
@SJR Да, Sheet2 должен быть местом назначения для вставки. Для меня все, что он делает, это вставка одной и той же строки в Sheet2. Это не создание списка. Всякий раз, когда в Sheet1.Range("A4:Q4") вносятся изменения, он должен копировать этот диапазон, а затем вставлять его под последней использованной строкой в Sheet2, но не поверх него. Надеюсь, это имеет смысл?
Вам нужно поместить 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
Потрясающий! Большое спасибо!
Действительно ли код срабатывает правильно при изменении ячейки? У вас есть что-нибудь в формате А4?