Копировать строки, которые не соответствуют критериям, с одного листа на другой

Question

Мой VBA копирует все строки (кроме заголовка) из одной рабочей таблицы в следующую пустую строку на другой рабочей таблице.

Sub Copy_Paste_Below_Last_Cell()

Dim copy_from As Range
Dim copy_to As Range

Set copy_from = Worksheets("Shipping Data").UsedRange.Offset(1, 0)
Set copy_to = Worksheets("Parts shipped YTD").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

copy_from.Copy Destination:=copy_to
Application.CutCopyMode = False

End Sub

Я хотел бы копировать только те строки, которые не имеют "Не доставлено" «в столбце R ко второму листу. Затем я хотел бы удалить строки с исходного листа, оставив только те, которые "не отправлены".

Answer 1

Настоящим и пример использования AutoFilter:

Sub Copy_Paste_Below_Last_Cell()

'Get all variables ready first
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Shipping Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Parts shipped YTD")
Dim lr1 As Long: lr1 = ws1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Dim lr2 As Long: lr2 = ws2.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Dim lc As Long: lc = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
Dim rng As Range: Set rng = ws1.Range(ws1.Cells(1, 1), ws1.Cells(lr1, lc))

'Apply test before AutoFilter
If WorksheetFunction.CountIf(rng.Columns(18), "<>Not Shipped") > 1 Then

    'Apply filter and copy visible rows
    rng.AutoFilter 18, "<>Not Shipped"
    rng.Offset(1).Resize(lr1 - 1, lc).SpecialCells(12).Copy ws2.Cells(lr2, 1)
    rng.Offset(1).Resize(lr1 - 1, lc).SpecialCells(12).Rows.EntireRow.Delete
    rng.AutoFilter

End If

End Sub