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