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