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

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

0 голосов
/ 10 апреля 2019

Я работаю над сценарием 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, копируя диапазон в следующую доступную пустую строку, как только происходят изменения. Было бы хорошо, если бы это было назначено кнопке, при которой один щелчок запускает регистратор, а другой - останавливает его, а не просто автоматически запускается, когда рабочая книга открыта, но теперь это тоже нормально.

Спасибо !!

UPDATE:

Я попытался вместо этого использовать этот код, но он по-прежнему не добавляет новую строку в 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! Ах!

1 Ответ

1 голос
/ 10 апреля 2019

Вам нужно поместить свой 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
...