der Code (mit lieben Ergängzungen aus dem Forum!) funktioniert.
Ich lasse jeweils eine Datei öffnen, auslesen, ausschneiden, einfügen.
Nun die Frage, wie kann ich "anstatt" jede "einzelne" Datei anzugeben (die sind ja alle in einem Ordner)
alle "*.xls" Datein auslesen.
Also anstatt :
" Workbooks.Open Filename:="C:\Testordner\Sport_1.xls""
" Workbooks.Open Filename:="C:\Testordner\SPort_2.xls""
etc.
dachte ich mit :
" Workbooks.Open Filename:="*.xls"
-> nur - dann habe ich eine Fehlermeldung (400).
Jemand einen Tipp für mich ?
Grüße
Fabio
Sub Dateien_in_eine_Tabelle_zusammenfuehren()
'(C) Unbekannt (Internet)
Dim Datei As String
Dim Arbeitsmappe As String
Dim Pfad As String
Pfad = "C:\Testordner\"
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
'Active Mappe
Arbeitsmappe = ActiveWorkbook.Name
'Öffnet eine Datei
Workbooks.Open Filename:="C:\Testordner\Sport_1.xls"
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
If ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row > 1 Then
Rows("2:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Cut _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
'Schliesst die geöffnete Datei
ActiveWorkbook.Save
ActiveWindow.Close
'Öffnet eine Datei
Workbooks.Open Filename:="C:\Testordner\SPort_2.xls"
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
If ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row > 1 Then
Rows("2:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Cut _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
'Schliesst die geöffnete Datei
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub