vba advanced_Filter help

[malleshg24]

Hi Team,


Need your help , I am collating all files from a folder with specific headers using advanced filter method.

Firstly I am Opening each file applying advanced filter, taking helper sheet for pasting filtered data.
and then copying helper sheets Data into Masterworkbook.

Can we shorten the code by taking header_row in memory. Attached my attempted workbook.

Datawbk.Sheets(1).Range("a1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ThisWorkbook.Worksheets("Header_Row).Range("a1:c1")




Regards,
mg

[mana]

Option Explicit


Sub Advance_Filter_Copy_Headers()
    Dim rgHeader As Range
    Dim wsCons As Worksheet
    Dim fPath As String
    Dim strFile As String

    Set rgHeader = ThisWorkbook.Worksheets("Header_Row").Range("a1:c1")
    Set wsCons = Workbooks.Add.Worksheets(1)
    rgHeader.Copy wsCons.Range("a1")
    
    fPath = ThisWorkbook.Worksheets("Mscro").Range("b4").Value
    strFile = Dir(fPath & "*.xlsx")
    
    Do While Len(strFile) > 0
        With Workbooks.Open(fPath & strFile, ReadOnly:=True)
            .Worksheets(1).Range("a1").CurrentRegion.AdvancedFilter xlFilterCopy, , rgHeader
            rgHeader.CurrentRegion.Offset(1).Copy wsCons.Range("a" & Rows.Count).End(xlUp).Offset(1)
            .Close
        End With
        strFile = Dir
    Loop


End Sub