VBA从AutoFilter复制并粘贴到另一个工作表中，输出一行

Question

我有一个AutoFilter，一旦应用它总是输出一个row。我希望copy这个row和paste另一个Sheet。

我考虑过：

• xlCellTypeAllValidation但它会抛出error
• xlCellTypeSameValidation有许多验证标准AutoFilter
• xlCellTypeLastCell但它提供了过滤后cell
中最后row的位置

我该怎么做？

以下是我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（在结束后）（假设数据从第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

此代码也会处理多行后过滤。

如果有帮助，请告诉我们。