'Copy Multiple Workbooks Data to the Masterfile based on Autofilter

To make it short, so I have this Masterfile called Archive with extraction button and I have multiple workbooks (20+).

In my Masterfile A1 field when I typed a particular date. (e.g. A1 = 21-May) and click Run. All my my workbooks(20+) will be filtered and copy all the data to my mastefile to the next available cell.

But I am nowhere near of that possibility. Hoping someone could actually assist me on doing this.. =(

Sub CopyRows()
    
    ' Source
    Const sFolderPath As String = "C:\Users\ChrisLacs\Desktop\My Files\"
    Const sFilePattern As String = "*.xlsm*"
    Const sName As String = "Sheet1"
    Const sAddress As String = "B200:N200"
    ' Destination
    Const dCol As String = "B"
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No files matching the pattern '" & sFilePattern _
            & "'" & vbLf & "found in '" & sFolderPath & "'.", vbExclamation
        Exit Sub
    End If
    
    Dim dwb As Workbook: Set dwb = Sheet4.Parent
    Dim dFileName As String: dFileName = dwb.Name
    Dim dCell As Range
    Set dCell = Sheet4.Cells(Sheet4.Rows.Count, dCol).End(xlUp).Offset(1)
    Dim drg As Range
    Set drg = dCell.Resize(, Sheet4.Range(sAddress).Columns.Count)
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim srg As Range
    Dim fCount As Long
    
    Do Until Len(sFileName) = 0
        If StrComp(sFileName, dFileName, vbTextCompare) <> 0 Then
            Set swb = Workbooks.Open(sFolderPath & sFileName)
            On Error Resume Next ' attenpt to reference the source worksheet
                Set sws = swb.Worksheets(sName)
            On Error GoTo 0
            If Not sws Is Nothing Then ' source worksheet found
                Set srg = sws.Range(sAddress)
                ' Either copy values, formulas, formats...
                srg.Copy drg
                ' ... or instead copy only values (more efficient (faster))
                'drg.Value = srg.Value
                Set drg = drg.Offset(1)
                Set sws = Nothing
                fCount = fCount + 1
            'Else ' source worksheet not found; do nothing
            End If
            swb.Close SaveChanges:=False
        End If
        sFileName = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "Rows copied: " & fCount, vbInformation
    
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source