Sub EinlesenDateienInEineGesamtTabelle()Code eingefügt mit Syntaxhighlighter 1.14
Dim i_Zeile As Integer
Dim i_Datei As Integer
Dim s_Mappe As String
Dim s_Tabelle As String
Dim i_Satzzähler As Integer
Dim s_Monat As String
s_Mappe = ThisWorkbook.Name
s_Tabelle = "Zusammenfassung"
With Workbooks(s_Mappe).Sheets(s_Tabelle)
.Cells(1, 1).Value = "Datum"
.Cells(1, 2).Value = "Umsatz"
.Cells(1, 3).Value = "Region"
.Cells(1, 4).Value = "Monat"
End With
i_Zeile = 2
Application.ScreenUpdating = False
'Eingabedateien ermitteln
With Application.FileSearch
.Filename = "*.xls"
.LookIn = "D:\Test\"
.SearchSubFolders = False
.Execute
For i_Datei = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i_Datei))
'Monat ermitteln
If InStr(ActiveWorkbook.Name, "Jan") > 0 Then s_Monat = "Januar"
If InStr(ActiveWorkbook.Name, "Feb") > 0 Then s_Monat = "Februar"
If InStr(ActiveWorkbook.Name, "Mär") > 0 Then s_Monat = "März"
If InStr(ActiveWorkbook.Name, "Apr") > 0 Then s_Monat = "April"
If InStr(ActiveWorkbook.Name, "Jun") > 0 Then s_Monat = "Juni"
If InStr(ActiveWorkbook.Name, "Jul") > 0 Then s_Monat = "Juli"
If InStr(ActiveWorkbook.Name, "Aug") > 0 Then s_Monat = "August"
If InStr(ActiveWorkbook.Name, "Sep") > 0 Then s_Monat = "September"
If InStr(ActiveWorkbook.Name, "Okt") > 0 Then s_Monat = "Oktober"
If InStr(ActiveWorkbook.Name, "Nov") > 0 Then s_Monat = "November"
If InStr(ActiveWorkbook.Name, "Dez") > 0 Then s_Monat = "Dezember"
'Einzelne Sätze übertragen
For i_Satzzähler = 2 To ActiveSheet.UsedRange.Rows.Count
With Workbooks(s_Mappe).Sheets(s_Tabelle)
.Cells(i_Zeile, 1).Value = ActiveSheet.Cells(i_Satzzähler, 1).Value
.Cells(i_Zeile, 2).Value = ActiveSheet.Cells(i_Satzzähler, 2).Value
.Cells(i_Zeile, 3).Value = Left(ActiveWorkbook.Name, 1)
.Cells(i_Zeile, 4).Value = s_Monat
End With
i_Zeile = i_Zeile + 1
Next i_Satzzähler
ActiveWorkbook.Close
Next i_Datei
End With
'Nach Datum sortieren
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub