Mehrere Exceldateien zu einer Excel Datei zusammenfassen - extended

@bastla
Hier also noch mal neu. Danke für deinen Tipp ;)

Hallo,
da mein Range dynamisch ist, hab ich etwas weiter gesucht und folgendes gefunden:

Sub Dateien_in_eine_Tabelle_zusammenfuehren()
'(C) Ramses
Dim Datei As String
Dim Arbeitsmappe As String
Dim Pfad As String
Pfad = "d:\workarea\"
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
'Active Mappe
Arbeitsmappe = ActiveWorkbook.Name
Do While Datei <> ""
'Öffnet eine Datei
Workbooks.Open Datei
'Kopiert von den Zeilen 6 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
Rows("6:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Copy _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
'Schliesst die geöffnete Datei
ActiveWorkbook.Close False
'Prüft für die nächste Datei
Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub

Hierbei steigt leider der Debugger in der Zeile "Workbooks.Open Datei" mit folgender Fehlermeldung aus:

Laufzeitfehler '1004': 'file1.xls' wurde nicht gefunden. Überprüfen Sie die Rechtschreibung des Dateinamens und überprüfen Sie, ob der Speicherort der Datei korrekt ist. Ist insofern kurios, da das Makro ja bereits im richtigen Verzeichnis den Namen der ersten Datei mit in der Fehlermeldung ausgibt.

Gruß
bolshi

Sub Dateien_in_eine_Tabelle_zusammenfuehren()
'(C) Ramses  
Pfad = "d:\workarea\" 'Am Ende einen "\" verwenden!  

Datei = Dir(Pfad & "*.xls")  
Application.ScreenUpdating = False
'Aktuelle Tabelle  
Set Sammeltabelle = ActiveWorkbook.ActiveSheet
Do While Datei <> ""  
    'Öffnet eine Datei  
    Workbooks.Open Pfad & Datei
    'Kopiert von den Zeilen 6 bis zum Ende  
    'in die aktive Mappe und fügt sie jeweils unten an  
    ActiveWorkbook.ActiveSheet.Rows("6:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Copy _  
    Destination:=Sammeltabelle.Range("A65536").End(xlUp).Offset(1, 0)  
    'Schliesst die geöffnete Datei  
    ActiveWorkbook.Close False
    'Prüft für die nächste Datei  
    Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub

ActiveWorkbook.ActiveSheet.Rows("1:" & ActiveWorkbook.ActiveSheet.Range("A1000000").End(xlUp).Row).Select _  
'Destination:=Sammeltabelle.Range("A1000000").End(xlUp).Offset(1, 0)  

Dim T
T = Workbooks(Arbeitsmappe).ActiveSheet.UsedRange.Rows.Count + 1

ActiveWorkbook.ActiveSheet.UsedRange.Copy _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A" & T)