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