Amend VBA code to copy just the visible cells

[Celticfc]

Hello everybody,

I found the below code and need help tweaking it so that it would copy just the filtered data from my table on Sheet1. Currently it copies everything under the headers. Any support is appreciated, many thanks in advance.

Sub CopyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, header As Range, foundHeader As Range, lCol As Long, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = desWS.Cells(1, Columns.Count).End(xlToLeft).Column
    For Each header In desWS.Range(desWS.Cells(1, 1), desWS.Cells(1, lCol))
        Set foundHeader = srcWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundHeader Is Nothing Then
            srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(LastRow, foundHeader.Column)).Copy desWS.Cells(2, header.Column)
        End If
    Next header
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

            srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(LastRow, foundHeader.Column)).SpecialCells(xlVisible).Copy desWS.Cells(2, header.Column)