Question

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

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

单元格T2包含“已解决”，但它将Range（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

进行了一些更改

VBA宏复制并粘贴不正确的行

1 个答案: