Hallo
das hab ich grad mal mit diversen Suchergebnissen dieses Forums runtergeschrieben.
Ich kommentiere es dir auch mal, damit du es nachvollziehen und ggf. anpassen kannst

Getestet hab ich nur EINE Tabelle je Datei. Ich wollte mir nicht noch Beispieldateien bauen.

Schau mal bitte, ob das deinem Problem hilft.

Grob gesagt: Dateien Öffnen, Bereich kopieren und in die Gesamtliste einfügen. Es wird
immer nur der gleiche Bereich kopiert. Zumindest hab ich so den ersten Post verstanden.

Gruß

--- Makro ---

Option Explicit

Sub DatenHolen()
    Dim strPfad As String
    Dim strDatei As String
    Dim strExt As String
    Dim rngBereich As Range
    
    Dim lngTabMax As Long
    Dim lngTab As Long
    
    Dim lngZmax As Long
    
    Dim WB As Workbook
    Dim WS As Worksheet
    
    Dim wsAusgabe As Worksheet
    
    'Fehlerbehandlung: ist nur das notwendigste
    On Error GoTo Aufräumen
    
    'AusgabeTabelle anpassen
    'eine neue Tabelle wird hinzugefügt
'    Set wsAusgabe = ThisWorkbook.Worksheets.Add
    
    'Fester Name
    Set wsAusgabe = ThisWorkbook.Worksheets("Tabelle1")
    
    Dim booAlleTabellen As Boolean
    
    Dim arrDaten As Variant
    Dim lngArrZmax As Long
    Dim lngArrSmax As Long
    
    'Pfadname anpassen
    strPfad = "C:\temp\test\"
    If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
    
    'Dateiendung anpassen
    strExt = "*.xls*"
        
    'Bereich der zu durchsuchenden Zellen anpassen
    Set rngBereich = Range("A1:C20")
    
    'Anpassen: False = nur erste Tabelle; True = alle Tabellen
    booAlleTabellen = False
    
    If booAlleTabellen = False Then
        lngTabMax = 1
        Else
        lngTabMax = WB.Worksheets.Count
    End If
    
    'Erste Datei suchen
    strDatei = Dir(strPfad & strExt)
    'Solange noch Dateien da sind
    Do While Len(strDatei) > 0
        'Datei öffnen
        Set WB = Workbooks.Open(Filename:=strPfad & strDatei, ReadOnly:=True)
        If Not WB Is Nothing Then
            'Wenn Datei offen dann alle gewünschten
            'Tabellen durchgehen (eine oder alle)
            For lngTab = 1 To lngTabMax
                'Tabelle auswählen
                Set WS = WB.Worksheets(lngTab)
                'Bereich in Variable schreiben
                arrDaten = WS.Range(rngBereich.Address)
                'Zielzeile suchen
                lngZmax = wsAusgabe.Cells(2 ^ 16, 1).End(xlUp).Row + 1
                'Arraygröße ermitteln
                lngArrZmax = UBound(arrDaten, 1)
                lngArrSmax = UBound(arrDaten, 2)
                'Daten ausgeben
                wsAusgabe.Range(wsAusgabe.Cells(lngZmax, 1), wsAusgabe.Cells(lngZmax + lngArrZmax - 1, lngArrSmax)) = arrDaten
            Next lngTab
            'Datei schliessen
            WB.Close False
        End If
        'nächste Datei
        strDatei = Dir()
    Loop


Aufräumen:
    'Notfalls Datei schliessen
    On Error Resume Next
    WB.Close False
    On Error GoTo 0
    
    'Variablen zurücksetzen
    Set WB = Nothing
    Set WS = Nothing
    Set rngBereich = Nothing
    Set wsAusgabe = Nothing
End Sub