VBA 宏正在复制和粘贴不正确的行答案

【问题标题】：VBA Macro is copy and pasting incorrect rowsVBA 宏正在复制和粘贴不正确的行
【发布时间】：2019-09-06 11:11:27
【问题描述】：

我创建了一个宏，它将自动过滤 T 列中的一系列单元格以获取“已解决”。然后它会将过滤后的数据复制并粘贴到另一个工作表中的下一个可用行。

当我运行宏时，它似乎正在复制和粘贴我所有列标题所在的第 1 行。

单元格 T2 包含“已解决”，但它正在将 Range(A1:M1) 粘贴到我的其他工作表中。

我尝试了各种更改，例如更改 Offset 和 End，但似乎没有任何效果。

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

任何帮助将不胜感激。

【问题讨论】：

标签： excel vba

【解决方案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

我对@987654322@做了一些修改

【讨论】：