简体   繁体   中英

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

I have an AutoFilter that once it is applied it always outputs one row . I want to copy this one row and paste it on another Sheet .

I have considered:

  • xlCellTypeAllValidation but it throws out an error
  • xlCellTypeSameValidation there are many validation criteria an AutoFilter
  • xlCellTypeLastCell but it gives the location of the last cell in the filtered row

How can i do this?

Here is an excerpt from my 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

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

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

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

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

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.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM