Tabellen konsolidieren

Sub KonsolidierenAlleDateien()
Dim Mappe As String
Dim i As Integer
Const LW = "F:\"
Const Pfad = "F:\VBA\"
ChDrive LW
ChDir Pfad
Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveWorkbook.SaveAs ("F:\VBA\Konsolidierung.xls")
Mappe = Dir(Pfad & "*.xls")
ChDir Pfad
Do While Mappe <> ""
Workbooks.Open Mappe
For i = 1 To Workbooks(Mappe).Sheets.Count
Workbooks(Mappe).Sheets(i).Copy _
Before:=Workbooks("Konsolidierung.xls").Sheets(1)
Next i
Workbooks(Mappe).Close SaveChanges:=False
Mappe = Dir
Loop
End Sub