Hallo,
Ich habe ca. 90 Excel Dateien, die alle eine Tabelle mit genau den selben Bezeichnungen enthalten (Material, Werk, Bezeichnung, Stückzahl,...). Nun möchte ich diese 90 Dateien zu einer zusammenführen und verwende folgendes Makro:
Sub Zusammenfuehren()
Dim strVerzeichnis As String
Dim strTyp As String
Dim strDateiname As String
Dim lngZeile As Long
strTyp = "*.xlsx*"
Application.ScreenUpdating = False
strVerzeichnis = ThisWorkbook.Worksheets("Sheet1").Range("A1")
'<==Verzeichnis steht in A1
If Right(strVerzeichnis, 1) <> "\" Then strVerzeichnis = strVerzeichnis & "\"
strDateiname = Dir(strVerzeichnis & strTyp)
lngZeile = 2
With ThisWorkbook.Worksheets("Tabelle1") '<==Zieltabelle anpassen
Do While strDateiname <> ""
Workbooks.Open Filename:=strVerzeichnis & strDateiname
ActiveWorkbook.Worksheets(1).Range("A1:L1020").Copy .Cells(lngZeile, 1) '<==Quelltabelle anpassen
.Range(.Cells(lngZeile, 3), .Cells(lngZeile + 14, 3)) = ActiveWorkbook.Name
'Daten in Quelltabelle löschen
ActiveWorkbook.Worksheets(1).Range("A1:L1020").ClearContents '<==Quelltabelle anpassen
'Quellmappe speichern und schließen
ActiveWorkbook.Close True
strDateiname = Dir
lngZeile = lngZeile + 15
Loop
End With
Application.ScreenUpdating = True
End Sub
Leider kommt bei der Zeile: strVerzeichnis = ThisWorkbook.Worksheets("Sheet1").Range("A1")
immer eine Fehlermeldung, dass der Index außerhalb des gültigen Bereichs liegt. Selbstverständlich habe ich für A1 das passende Verzeichnis (F:\Config\Profil\Desktop\PCC SAP Listen\Sicherung PCC Stücklisten\5200) eingefügt.
Könnte mir hier vielleicht jemand helfen?
|