I am trying to filter & select all columns (A to R) which contain the value "New" in column R. I then want to copy this selection and paste as value it to the bottom of the table on worksheet "Worklist".
I don't understand why the code is using an "If" function to look at the subtotal and think I did the copy & pasting part wrong, since I'm getting an error.
Sub CopyPartOfFilteredRange()
Dim lastRow As Long
With ThisWorkbook.Sheets("ProcessingSheet")
.AutoFilterMode = False
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:R" & lastRow)
.AutoFilter Field:=18, Criteria1:="New"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destinations:=Sheets("Worklist").Cells(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 1)
End If
End With
End With
End Sub
Range.Subtotal method
SpeacialCells will raise an error if no matching values are found by the AutoFilter. Subtotal is used to avoid this by returning the number of found values.
The Code
Option Explicit
Sub CopyPartOfFilteredRange()
With ThisWorkbook.Sheets("ProcessingSheet")
.AutoFilterMode = False
Dim lastRow As Long: lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:R" & lastRow)
.AutoFilter Field:=18, Criteria1:="New"
If WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
Dim dws As Worksheet
Set dws = ThisWorkbook.Worksheets("Worklist")
.Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=dws.Cells(dws.Range("B" & dws.Rows.Count) _
.End(xlUp).Row + 1, 1)
End If
End With
.AutoFilterMode = False
End With
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With