Excel VBA：过滤、剪切并粘贴到其他图纸

第一张表名为

src

，第二张表名为

dst

，目前为空表

我的计划是过滤B列中的字符串

x

，将其剪切并粘贴到第二页

dst

VBA代码

Sub filter_copy_paste()

With Sheets("src")
    .Range("A1").AutoFilter Field:=2, Criteria1:="x"
    With .AutoFilter.Range
        With .SpecialCells(xlCellTypeVisible).EntireRow
            .Copy
            With Sheets("dst")
                .Paste
                .[A1].Select
            End With
        End With
    End With
End With

End Sub

Option Explicit

' If you already have the headers in "dst".
Sub filter_copy_paste()

    With Worksheets("src")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        Dim rng As Range
        Set rng = .Range("A1").CurrentRegion
        rng.AutoFilter Field:=2, Criteria1:="x"
        Dim cRng As Range
        On Error Resume Next
        Set cRng = rng.Resize(rng.Rows.Count - 1).Offset(1) _
                      .SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0
        If cRng Is Nothing Then
            GoTo showAll
        End If
        Dim pRng As Range
        Set pRng = Worksheets("dst").Range("A2")
        'With pRng
        '    .EntireRow.Resize(.Worksheet.Rows.Count - .Row + 1).Clear
        'End With
        cRng.Copy Destination:=pRng
        cRng.Delete
showAll:
        .ShowAllData
    End With

End Sub

' If you don't have the headers in "dst".
Sub filter_copy_pastenh()

    With Worksheets("src")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        Dim rng As Range
        Set rng = .Range("A1").CurrentRegion
        rng.AutoFilter Field:=2, Criteria1:="x"
        Dim cRng As Range
        On Error Resume Next
        Set cRng = rng.Resize(rng.Rows.Count - 1).Offset(1) _
                      .SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0
        If cRng Is Nothing Then
            GoTo showAll
        End If
        Dim pRng As Range
        Set pRng = Worksheets("dst").Range("A1")
        'pRng.Worksheet.Cells.Clear
        Union(rng.Rows(1).EntireRow, cRng).Copy Destination:=pRng
        cRng.Delete
showAll:
        .ShowAllData
    End With

End Sub

但是，当我运行它时出现错误，当我点击

Debug

时，它会突出显示第5行，该行是带有.AutoFilter.Range的

这段代码有什么错误，我应该怎么做才能修复它

第1页中的所需输出
src


第二张图纸中的所需输出
dst

如果您查看此处的文档：

您可以看到autofilter不返回范围

这相当于使用Excel功能进行过滤。这意味着您必须在移动此数据之前选择此子集。
自动筛选“剪切/粘贴”
代码

Sub filter_copy_paste()

With Sheets("src")
    .Range("A1").AutoFilter Field:=2, Criteria1:="x"
    With .AutoFilter.Range
        With .SpecialCells(xlCellTypeVisible).EntireRow
            .Copy
            With Sheets("dst")
                .Paste
                .[A1].Select
            End With
        End With
    End With
End With

End Sub

Option Explicit

' If you already have the headers in "dst".
Sub filter_copy_paste()

    With Worksheets("src")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        Dim rng As Range
        Set rng = .Range("A1").CurrentRegion
        rng.AutoFilter Field:=2, Criteria1:="x"
        Dim cRng As Range
        On Error Resume Next
        Set cRng = rng.Resize(rng.Rows.Count - 1).Offset(1) _
                      .SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0
        If cRng Is Nothing Then
            GoTo showAll
        End If
        Dim pRng As Range
        Set pRng = Worksheets("dst").Range("A2")
        'With pRng
        '    .EntireRow.Resize(.Worksheet.Rows.Count - .Row + 1).Clear
        'End With
        cRng.Copy Destination:=pRng
        cRng.Delete
showAll:
        .ShowAllData
    End With

End Sub

' If you don't have the headers in "dst".
Sub filter_copy_pastenh()

    With Worksheets("src")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        Dim rng As Range
        Set rng = .Range("A1").CurrentRegion
        rng.AutoFilter Field:=2, Criteria1:="x"
        Dim cRng As Range
        On Error Resume Next
        Set cRng = rng.Resize(rng.Rows.Count - 1).Offset(1) _
                      .SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0
        If cRng Is Nothing Then
            GoTo showAll
        End If
        Dim pRng As Range
        Set pRng = Worksheets("dst").Range("A1")
        'pRng.Worksheet.Cells.Clear
        Union(rng.Rows(1).EntireRow, cRng).Copy Destination:=pRng
        cRng.Delete
showAll:
        .ShowAllData
    End With

End Sub