VBA to copy filtered table data to the end of another table

[Whittlebury]

I'm trying to copy the 1st 3 columns of a filtered table to the bottom of another table on a different worksheet but only if any rows have been found.
The following works ok (but happy to know any better solutions) but I need to check if any filtered rows are found as otherwise it copies the entire table.
Many thanks

Sub CopyNewFiles()
'
' CopyNewFiles Macro
'

'
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim lr As Variant
    Dim lo As ListObject
    
    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")
    
    Application.ScreenUpdating = False
    
    ' Refresh the csv import table
    'wb.RefreshAll
    
    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"
    
    'If the filtered table contains any rows Then [B]<< this condition is the bit I'm struggling with[/B]
    
        'Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add
        
        'Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy
        
        'Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues
    
    'End If
        
    'De-select the input data
    Application.CutCopyMode = False
    
End Sub

 

[excel_learnerz]

To check if there are any filtered rows, you can use the SpecialCells method with the xlCellTypeVisible constant. The following modification to your code will check if there are any visible rows in the filtered table before proceeding with the copy operation:

This code checks if there are any visible cells in the filtered table before copying and pasting the data. Additionally, it clears the filter at the end by using the ShowAllData method.

 

[excel_learnerz]

Sub CopyNewFiles()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim lr As Variant
    Dim lo As ListObject

    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")

    Application.ScreenUpdating = False

    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"

    ' Check if any filtered rows are found
    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = ws1.ListObjects("link_report").DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' If the filtered table contains any rows
    If Not visibleCells Is Nothing Then

        ' Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add

        ' Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy

        ' Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues

    End If

    ' De-select the input data
    Application.CutCopyMode = False

    ' Clear the filter
    ws1.ListObjects("link_report").AutoFilter.ShowAllData

    Application.ScreenUpdating = True
End Sub

 

[Whittlebury]

Sub CopyNewFiles()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim lr As Variant
    Dim lo As ListObject

    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")

    Application.ScreenUpdating = False

    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"

    ' Check if any filtered rows are found
    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = ws1.ListObjects("link_report").DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' If the filtered table contains any rows
    If Not visibleCells Is Nothing Then

        ' Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add

        ' Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy

        ' Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues

    End If

    ' De-select the input data
    Application.CutCopyMode = False

    ' Clear the filter
    ws1.ListObjects("link_report").AutoFilter.ShowAllData

    Application.ScreenUpdating = True
End Sub

That works fine for me. Thanks for the quick response!