Sub Schliessen()
Dim wkb As Workbook
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Close savechanges:=False
End If
Next wkb
End Sub
Sub Dateien_in_eine_Tabelle_zusammenfuehren()
'(C) Ramses
Dim Datei As String
Dim Arbeitsmappe As String
Dim Pfad As String
Pfad = (ThisWorkbook.Path & "\")
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
'Active Mappe
Arbeitsmappe = ActiveWorkbook.Name
Do While Datei <> ""
'Öffnet eine Datei
Workbooks.Open Pfad & Datei
'Kopiert von den Zeilen 1 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
Rows("1:" & 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