Hallo allerseits,

ich möchte gerne mehrere Excel-Dateien in einem Ordner, die jeweils eine Tabelle enthalten, in einer Master-Datei zusammenführen. Anbei mein aktueller Code.

Die erste Datei soll vollständig übernommen werden, ab der 2. Datei reicht die Tabelle jeweils ab Zelle D10.

Beim Ausführen der Datei erhalte ich allerdings einen Laufzeitfehler 1004. Die beim Debuggen hervorgehoben Zeile habe ich unten kommentiert. 

Kann mir hier jemand weiterhelfen, wie der Fehler zu beheben ist?

Vielen Dank!!!

---

Sub Merge_tables()
    Dim strVerzeichnis As String
    Dim strTyp As String
    Dim strDateiname As String
    Dim lngZeile As Long
    Dim nbr As Long
    nbr = 0
    strTyp = "*.xls*"
    Application.ScreenUpdating = False
    strVerzeichnis = "Ordnerpfad" 'Hier Ordner mit Einzeldateien definieren
    strDateiname = Dir(strVerzeichnis & strTyp)
    lngZeile = 10
    
    With ThisWorkbook.Worksheets("Tabelle1")
    
        Do While strDateiname <> ""
            
            nbr = nbr + 1
            
            If nbr = 1 Then
                        
                'Einzeldatei öffnen
                Workbooks.Open Filename:=strVerzeichnis & strDateiname
                        
                'Letzte Zeile der Einzeldatei bestimmen
                Letzte_zeile = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 'In Spalte 5 wird nach letzter zu kopierender Zeile gesucht
                                        
                'Erste Einzeldatei in Gesamtdokument kopieren
                ActiveWorkbook.Worksheets(1).Range("A1:CZ" & Letzte_zeile).Copy .Cells(1, 1) 'Erste Einzeldatei wird bis Spalte CZ in Zelle A1 kopiert
            
                'Einzeldatei speichern und schließen
                ActiveWorkbook.Close True
                strDateiname = Dir
                lngZeile = lngZeile + Letzte_zeile - 10
                
            Else
            
                'Einzeldatei öffnen
                Workbooks.Open Filename:=strVerzeichnis & strDateiname
                        
                'Letzte Zeile der Einzeldatei bestimmen
                Letzte_zeile = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 'In Spalte 5 wird nach letzter zu kopierender Zeile gesucht
                        
                'Restliche Einzeldateien in Gesamtdokument kopieren
                ActiveWorkbook.Worksheets(1).Range("D10:CZ" & Letzte_zeile).Copy .Cells(lngZeile, 4) 'Restliche Einzeldateien werden bis Spalte CZ in Spalte D kopiert/angehängt ### ZEILE BEIM DEBUGGEN HERVORGEHOBEN ###
            
                'Einzeldatei speichern und schließen
                ActiveWorkbook.Close True
                strDateiname = Dir
                lngZeile = lngZeile + Letzte_zeile - 10
            
            End If
            
        Loop
    
    End With
    
    Application.ScreenUpdating = True

End Sub