Цикл передачи значений в нижнюю часть диапазона ошибочно перезаписывает значения

Question

У меня есть диапазон, используемый как дамп необработанных данных из другого макроса.В этом диапазоне я хочу, чтобы vba прошел через определенные столбцы (столбец Q), когда критерий равен 1, скопируйте целевой диапазон и переместитесь в конец таблицы.Я не знаю vba для таблицы, поэтому просто определил последнюю строку, добавил 1 для вставки внизу таблицы, поскольку таблица автоматически изменит размер.

Мой код делает все, что мне нужно, кроме следующего: каждый экземпляр, который он находит, он вставляет внизу ... но когда он зацикливается, он перезаписывает последнюю запись, которая была сделана внизу таблицы, вместо поиска новой строки и вставки ниже.Я попытался добавить таймер отключения, и именно так я смог увидеть его перезапись, но это не помогло решить проблему.

Диапазон дампа данных: столбцы со значениями W до AC начинаются со строки 4 и заканчиваются последней строкой.из дампа данных.Столбец X - столбец Критерии, 0 или 1. Если 1, то данные необходимо переместить.Столбцы с X по AA с критериями = 1 перемещаются из этой области в таблицу.

Таблица начинает A3 для заголовков и вплоть до строки 309. Если у меня есть 5 записей из дампа данных, то я ожидаюте значения, которые должны быть вставлены ниже таблицы, начиная с столбца C. Поэтому расширив строку с 309 до 313.

Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

Sub test1()
    Dim Cell As Range
    Dim lastrow As Long
    Dim TargtRng As Range

    With Sheets("Data_Rates")
        lastrow = Worksheets("Data_Rates").Cells(Rows.Count, "C").End(xlUp).Row + 1

        For Each Cell In .Range("X4:X" & .Cells(.Rows.Count, "X").End(xlUp).Row)
            If Cell.Value = "1" Then
                '.Range(Cell, Cell.Offset(, 3)).Copy Destination:=.Cells(lastrow, "C")
                Set TargtRng = .Range(Cell, Cell.Offset(, 3))
                .Range(Cells(lastrow, "C"), Cells(lastrow, "E")).Resize(TargtRng.Rows.Count, TargtRng.Columns.Count).Value = TargtRng.Cells.Value
                Sleep (500)
            End If
        Next Cell
    End With
End Sub

Answer 1

Попробуйте это, немного упростив, но самое главное с последней переменной строки внутри цикла, чтобы она обновлялась при копировании большего количества данных.

Sub test1()

Dim Cell As Range
Dim lastrow As Long
Dim TargtRng As Range

With Sheets("Data_Rates")
    For Each Cell In .Range("X4:X" & .Cells(.Rows.Count, "X").End(xlUp).Row)
        If Cell.Value = 1 Then
            lastrow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
            .Cells(lastrow, "C").Resize(, 4).Value = Cell.Resize(, 4).Value
        End If
    Next Cell
End With

End Sub