Excel VBA：过滤、剪切并粘贴到另一个工作表

Question

第一张名为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

但是，当我运行它时出现错误，当我点击Debug ，它会突出显示第 5 行，即With .AutoFilter.Range

这段代码有什么问题，我应该怎么做才能修复它？

第一张src所需输出

第二张纸dst所需输出

Answer 1

如果您查看此处的文档： https : //docs.microsoft.com/en-us/office/vba/api/excel.range.autofilter

您可以看到自动过滤器不返回范围。

这相当于使用 Excel 功能进行过滤。 这意味着您必须在移动此数据之前选择此子集。

Answer 2

自动筛选“剪切/粘贴”

编码

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