#1 14. Januar 2013 Excel Makro: mehrere Dateien zusammenführen Hallo zusamen, ich möchte ein Excel-Makro erstellen, das folgende Aufgabe erfüllt: Info: gegeben sei ein Ordner z. B. "Test" mit mehreren Excel-Dokumenten mit Typ .xls Die Anzahl der Dokumente ist nicht bekannt bzw. ändert sich immer. Das Makro soll nun in einem Excel-Dokument ausgeführt werden und alle Dokumente im Ordner "Test" und alle Arbeitsmapppen der jeweiligen Dokumente (Sheet1, Sheet2, ...) in eine neue Datei zusammenführen. Jedes Dokument und Mappe soll in einem neuen Dokument einen Reiter bekommen. Das Dokument, in dem das Makro hinterlegt ist, soll unverändert bleiben. Im Internet habe ich folgenden Code gefunden, der aber nur zum Teil den Ansprüchen genügt. Code: Public Sub Daten_mehrerer_Dateien_zusammenfuehren() 'Code für ein allgemeines Modul '******************************** 'Autor: Jürgen Hennekes '******************************** On Error GoTo errExit Dim WBQ As Workbook Dim WBZ As Workbook Dim varDateien As Variant Dim lngAnzahl As Long Dim lngLastQ As Long Set WBZ = ActiveWorkbook 'Altdaten auf Zielblatt löschen WBZ.Worksheets(1).Range("A2:IV65536").ClearContents varDateien = _ Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren", False, True) With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With For lngAnzahl = LBound(varDateien) To UBound(varDateien) Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl)) lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _ Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1) WBQ.Close Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64 Exit Sub errExit: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With If Err.Number = 13 Then MsgBox "Es wurde keine Datei ausgewählt" Else MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _ & "Fehlernummer: " & Err.Number & vbCr _ & "Fehlerbeschreibung: " & Err.Description End If End Sub Ich hoffe, mir kann jemand weiterhelfen. Danke und Gruß, joker.org P.S. bei Fragen oder Unklarheiten bitte melden... + Multi-Zitat Zitieren