VBA 从自动筛选器中复制并粘贴到另一个工作表中，输出一行

VBA Copy and Paste in another Sheet from AutoFilter outputting one row

提问by ExoticBirdsMerchant

I have an AutoFilterthat once it is applied it alwaysoutputs one row. I want to copythis one rowand pasteit on another Sheet.

我有一个AutoFilter一旦应用它总是输出一个row。我想要copy这个row和paste它在另一个Sheet。

I have considered:

我考虑过：

• xlCellTypeAllValidationbut it throws out an error
• xlCellTypeSameValidationthere are many validation criteria an AutoFilter
• xlCellTypeLastCellbut it gives the location of the last cellin the filtered row

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

How can i do this?

我怎样才能做到这一点？

Here is an excerpt from my code:

这是我的摘录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

回答by Rory

I'd recommend testing to ensure something actually matched the criteria before you copy - something like:

我建议在复制之前进行测试以确保某些内容实际上符合标准 - 例如：

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

回答by apc

You can select all filtered region and then copy it, it will copy visible rows only anyway. Or combine it with .SpeciallCells(xlCellTypeVisible)

您可以选择所有过滤的区域然后复制它，它只会复制可见的行。或者将它与 .SpecialCells(xlCellTypeVisible) 结合使用

Smthng like (after End With) (assuming data starts from Row 2)

Smthng like (after End With)（假设数据从第 2 行开始）

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

回答by Jerome Montino

One approach is to use Special Cells targeting visible cells only. One really quick and painless variant is to just use offset.

一种方法是使用仅针对可见单元格的特殊单元格。一种非常快速且无痛的变体是仅使用偏移量。

See the following:

请参阅以下内容：

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

Screenshots:

截图：

Source (with filter):

来源（带过滤器）：

Result:

结果：

Something to keep as a an alternative.

作为替代品保留的东西。

Let us know if this helps.

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

EDIT:

编辑：

This code is as per exchange in comments. Read the comments and modify it to suit your needs.

此代码根据评论中的交流。阅读评论并修改它以满足您的需要。

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

This code handles multiple rows post-filter as well.

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

Let us know if this helps.

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