Для Next l oop - скопировать ячейки на основе значения на другой лист и сложить их в конце таблицы

Question

Я пытаюсь скопировать значения с одного листа на другой, имеющие заданное значение c, заданное на основе формулы. Каждый месяц добавляются новые записи, а затем они сравниваются с уже существующим списком. Если формула возвращает «NEW», то эту запись следует добавить в список.

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

Вот что я получил:

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row
        LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub 

Здесь мои нынешние знания останавливаются. Я действительно оценил бы, если бы кто-то мог указать на то, что мне не хватает.

Том

Answer 1

Проблема в том, что если вы вычисляете последнюю строку за пределами вашего l oop, но используете его внутри вашего l oop (несколько раз), он не будет обновляться, а строка, вставленная в, останется одни и те же. Попробуйте вместо этого:

Sub CopyX()
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim SrchRng1 As range
    Dim cel As range
        LastRow1 = Sheets("RAW INPUT").Cells(Rows.Count, 11).End(xlUp).Row

        Set SrchRng1 = Sheets("RAW INPUT").range("L8:L" & LastRow1)
            For Each cel In SrchRng1
                If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    LastRow2 = Sheets("CALC_corrected").Cells(Rows.Count, 2).End(xlUp).Row
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                End If
            Next cel
End Sub 

Таким образом, последняя строка будет обновляться при каждом запуске l oop и будет на 1 строку выше.

Answer 2

Вам нужно увеличить lastrow2, оно не меняется, когда вы получаете больше «НОВЫХ» ячеек.

               If cel = "NEW" Then
                    cel.Offset(0, -1).Copy
                    Sheets("CALC_corrected").Cells(LastRow2, 3).Offset(1, 0).PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    LastRow2 = LastRow2 + 1
                End If