VBA從自動篩選器中復制並粘貼到另一張工作表中，輸出一行

Question

我有一個自動AutoFilter ，一旦應用它就總是輸出row 。 我要copy這一row paste其paste到另一Sheet 。

我考慮過：

• xlCellTypeAllValidation但拋出error
• xlCellTypeSameValidation有很多驗證條件的AutoFilter
• xlCellTypeLastCell但它提供了已過濾row最后一個cell的位置

我怎樣才能做到這一點？

這是我的code的摘錄：

With ThisWorkbook.Sheets(k).Range("A1:AZ1")
        .Value = .Value
        .AutoFilter field:=1, Criteria1:=Rev_1
        .AutoFilter field:=11, Criteria1:=Beginnings(k)
        .AutoFilter field:=12, Criteria1:=End_Instnts(k)

        For zz = 13 To last_Field
            .AutoFilter field:=zz, Criteria1:=""
        Next zz
        .SpecialCells(xlCellTypeLastCell).Select
        .Range.Select

     ThisWorkbook.Sheets(k).AutoFilterMode = False


End With

Answer 1

我建議您進行測試，以確保在復制之前確實符合標准：

With ThisWorkbook.Sheets(k).Range("A1").CurrentRegion.Resize(, 52)
    .Value = .Value
    .AutoFilter field:=1, Criteria1:=Rev_1
    .AutoFilter field:=11, Criteria1:=Beginnings(k)
    .AutoFilter field:=12, Criteria1:=End_Instnts(k)

    For zz = 13 To last_Field
        .AutoFilter field:=zz, Criteria1:=""
    Next zz
    ' make sure there are results matching filter
    If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        ' offset and resize to avoid headers then copy
        .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("other sheet").Range("A1")
    End If

    ThisWorkbook.Sheets(k).AutoFilterMode = False

End With

Answer 2

您可以選擇所有過濾的區域，然后復制它，它將始終只復制可見的行。 或將其與.SpeciallCells（xlCellTypeVisible）組合

Smthng like（在End With之后）（假設數據從第2行開始）

Range("A2:AZ1").Copy Destination:=PasteRange

Answer 3

一種方法是使用僅針對可見細胞的特殊細胞。 一種真正快速且輕松的變體是僅使用偏移。

請參閱以下內容：

Sub CopyFilterResult()

    Dim WS1 As Worksheet, WS2 As Worksheet

    With ThisWorkbook
        Set WS1 = .Sheets("Sheet1")
        Set WS2 = .Sheets("Sheet2")
    End With

    'Apply your filters here.

    WS1.UsedRange.Offset(1, 0).Copy WS2.Range("A1")

End Sub

屏幕截圖：

來源（帶過濾器）：

結果：

可以選擇保留的東西。

讓我們知道是否有幫助。

編輯：

該代碼是按注釋交換的。 閱讀評論並對其進行修改以滿足您的需求。

Sub CopyAfterFilterMk2()

    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim RngBeforeFilter As Range, RngAfterFilter As Range
    Dim LCol As Long, LRow As Long

    With ThisWorkbook
        Set WS1 = .Sheets("Sheet1")
        Set WS2 = .Sheets("Sheet2")
    End With

    With WS1
        'Make sure no other filters are active.
        .AutoFilterMode = False
        'Get the correct boundaries.
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LCol = .Range("A1").End(xlToRight).Column
        'Set the range to filter.
        Set RngBeforeFilter = .Range(.Cells(1, 1), .Cells(LRow, LCol))
        RngBeforeFilter.Rows(1).AutoFilter Field:=1, Criteria1:="o"
        'Set the new range, but use visible cells only.
        Set RngAfterFilter = .Range(.Cells(2, 1), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)
        'Copy the visible cells from the new range.
        RngAfterFilter.Copy WS2.Range("A1")
        'Turn off the filter.
        .AutoFilterMode = False
    End With

End Sub

該代碼還處理多行后過濾器。

讓我們知道是否有幫助。