Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to filter range and copy to bottom of table in different sheet?

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
like image 291
Casper Avatar asked Dec 28 '25 16:12

Casper


1 Answers

Copy Filtered Data feat. Subtotal

  • 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
like image 99
VBasic2008 Avatar answered Dec 30 '25 21:12

VBasic2008