Abey dosyada kod yok ayrıca videoyu izleyip uygulamanızı önermiştim bende uyguladım ufak tefek değişiklik yaparak.
Alttaki kodu deneyin.
Hata olursa koddaki Türkçe karakterleri düzeltin.

Sub test()

    Dim rs As Object, con As Object, Sql As String

    

    Set rs = CreateObject("ADODB.Recordset")

    Set con = CreateObject("ADODB.Connection")

    Dim yol As String, yol2 As String

    

    yol = ThisWorkbook.Path & Application.PathSeparator

    yol2 = Dir(yol & "*xlsx")



    With ThisWorkbook.Sheets("TümVeri")

        .Range("A2:Q" & Rows.Count).Clear

        Do Until yol2 = ""

            If Not yol2 Like "00 -Tüm Veri*" Then

                con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""

                Sql = Sql & " union all select * from [MEMURLAR$]"

                Sql = Mid(sql, 12)

                rs.Open sql, con, 1, 1

                .Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset rs

                Sql = ""

                rs.Close

                con.Close

            End If

            yol2 = Dir

        Loop

    End With

    Set rs = Nothing

    Set con = Nothing

End Sub