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.