VBA Macro - копирование и вставка неправильных строк

Question

Я создал макрос, который будет автоматически фильтровать диапазон ячеек в столбце T для «Разрешено». Затем он скопирует и вставит отфильтрованные данные в следующую доступную строку на другом листе.

Когда я запускаю макрос, кажется, что он копирует и вставляет строку 1, в которой находятся все мои заголовки столбцов.

Ячейка T2 Содержит «Разрешено», но она вставляет Диапазон (A1: M1) в мой другой лист.

Я пробовал различные изменения, такие как изменение смещения и конца, но, похоже, ничего не работает.

Sub MoveToPay()

Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("iSeries £ Pay")
Dim lr As Long
Dim S As String
Dim SearchRng As Range, Cell As Range


Application.ScreenUpdating = False


If Not IsError(Application.Match("Resolved", Range("T2:T250"), 0)) Then

    Columns(20).AutoFilter 1, "Resolved"
    With Range("a2", Range("M" & Rows.Count).End(3)).SpecialCells(xlCellTypeVisible)
        .Copy PasteSheet.Cells(Rows.Count, 1).End(1).Offset
        .EntireRow.Delete
    End With
    Columns(20).AutoFilter


    MsgBox "Resolved Invoices have been transfered to Ready to Pay"

Else

    MsgBox "No Invoices are marked as resolved"
    Exit Sub

End If


Application.ScreenUpdating = True

End Sub

Любая помощь будет высоко ценится.

Answer 1

Попробуйте это:

Sub MoveToPay()
    Dim CopySheet As Worksheet
    Set CopySheet = Sheets("Can't Pay")
    Dim PasteSheet As Worksheet
    Set PasteSheet = Sheets("iSeries £ Pay")
    Dim lastrow As Integer
    Dim lastrow2 As Integer

    lastrow = CopySheet.Range("M" & Rows.Count).End(xlUp).Row
    lastrow2 = PasteSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

    Application.ScreenUpdating = False

    If Not IsError(Application.Match("Resolved", Range("T2:T250"), 0)) Then

        ' copy Resolved data
        CopySheet.Range("A2:T" & lastrow).Select
        CopySheet.Range("A1:T" & lastrow).AutoFilter Field:=20, Criteria1:="Resolved"
        Selection.Copy

        ' paste it to other sheet
        PasteSheet.Range("A" & lastrow2).PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False

        ' remove Resolved data from CopySheet, offsetting to exclude headers
        With CopySheet.Range("A1:T" & lastrow)
          .AutoFilter Field:=20, Criteria1:="Resolved"
          .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        ' remove AutoFilter
        CopySheet.Columns(20).AutoFilter

        MsgBox "Resolved Invoices have been transfered to Ready to Pay"

    Else
        MsgBox "No Invoices are marked as resolved"
        Exit Sub
    End If


    Application.ScreenUpdating = True

End Sub

Я внес некоторые изменения в Dim