Копировать диапазон в следующую строку другого листа при обнаружении изменения

Я работаю над сценарием 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! Ах!

Действительно ли код срабатывает правильно при изменении ячейки? У вас есть что-нибудь в формате А4?

SJR 10.04.2019 18:08
Cells(Rows.Count Я могу подумать, что вам также нужно подтвердить rows.count на листе 2
Davesexcel 10.04.2019 18:13

@SJR Да, в Sheet1.A4 есть значение, и оно отслеживает весь диапазон, поэтому, если какое-либо значение ячейки изменяется в диапазоне, оно должно копироваться

Matt Wilson 10.04.2019 18:42

Ваш код работает для меня. Является ли «Лист2» ​​определенно правильным листом?

SJR 10.04.2019 18:45

@SJR Да, Sheet2 должен быть местом назначения для вставки. Для меня все, что он делает, это вставка одной и той же строки в Sheet2. Это не создание списка. Всякий раз, когда в Sheet1.Range("A4:Q4") вносятся изменения, он должен копировать этот диапазон, а затем вставлять его под последней использованной строкой в ​​Sheet2, но не поверх него. Надеюсь, это имеет смысл?

Matt Wilson 10.04.2019 19:14
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
5
90
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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

Потрясающий! Большое спасибо!

Matt Wilson 10.04.2019 23:47

Другие вопросы по теме

Входы взаимности МЕТРИЧЕСКИЕ <---> ИМПЕРИАЛЬНЫЕ
Как с помощью VBA загрузить набор данных API в Excel из функции HTTP GET?
Найдите переменную заголовка пользовательской формы в CSV, чтобы получить другие значения
Как изменить отступ после преобразования всех абзацев в таблицу в документе Word с помощью VBA?
Пользовательская форма Excel VBA — использование той же формы для создания непрерывных данных
Сравнение 2 динамических массивов разных размеров и просмотр, сколько совпадений
Доступ: значения поля со списком зависят от предыдущего поля со списком
Параметр (Private WithEvents As Sheet1) sheetUI = Sheet1 вызывает ошибку 438: объект не поддерживает это свойство или метод
Код для объединения соседних ячеек с использованием VBA больше не работает, и я не могу найти проблему
Как я могу исправить ошибку времени выполнения 430 из-за импорта пользовательской DLL в проект VBA