Wie durchläuft man alle Arbeitsmappen in einem Verzeichnis und kopiert deren Daten in ein zentrales Master-Arbeitsblatt in Excel?
Angenommen, Sie haben mehrere Excel-Arbeitsmappen in einem Ordner und möchten alle diese Dateien durchlaufen, um Daten aus einem bestimmten Bereich eines konsistenten Arbeitsblatts (z. B. Tabelle1) in ein Hauptarbeitsblatt zu kopieren. Diese Anleitung liefert eine detaillierte VBA-Lösung, um diesen Prozess in Excel effizient zu automatisieren.
Durchlaufen von Dateien in einem Verzeichnis und Kopieren von Daten in ein Master-Arbeitsblatt mit VBA-Code
Wenn Sie Daten aus dem Bereich A1:D4 aller Tabellen1-Arbeitsblätter sämtlicher Arbeitsmappen in einem bestimmten Ordner kopieren und in ein Master-Arbeitsblatt einfügen möchten, gehen Sie wie folgt vor.
1. Drücken Sie in der Arbeitsmappe, in der Sie ein Hauptarbeitsblatt erstellen möchten, die Tastenkombination Alt+F11, um das Fenster Microsoft Visual Basic for Applications zu öffnen.
2. Klicken Sie im Fenster Microsoft Visual Basic for Applications auf Einfügen > Modul. Kopieren Sie anschließend den folgenden VBA-Code in das Codefenster.
VBA-Code: Durchlaufen von Dateien in einem Ordner und Kopieren von Daten in ein Master-Arbeitsblatt
Sub Merge2MultiSheets()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.Item(1)
Set xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("New Sheet")
If xSheet Is Nothing Then
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
Set xSheet = xWorkBook.Sheets("New Sheet")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dir()
xBook.Close
Loop
End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubHinweis:
3. Drücken Sie die Taste F5, um den Code auszuführen.
4. Wählen Sie im geöffneten Durchsuchen-Fenster den Ordner aus, der die Dateien enthält, die Sie durchlaufen möchten, und klicken Sie anschließend auf die Schaltfläche OK. Siehe Screenshot:
Ein Hauptarbeitsblatt mit dem Namen „Neues Blatt“ wird am Ende der aktuellen Arbeitsmappe erstellt. Die Daten aus dem Bereich A1:D4 aller Tabellen1 im ausgewählten Ordner werden in diesem Arbeitsblatt aufgelistet.
Verwandte Artikel:
Beste Office-Produktivitätstools
Verbessern Sie Ihre Excel-Kenntnisse mit Kutools für Excel und erleben Sie Effizienz wie nie zuvor.Kutools für Excel bietet über 300 erweiterte Funktionen zur Steigerung der Produktivität und Zeit sparen.Klicken Sie hier, um die Funktion zu erhalten, die Sie am dringendsten benötigen...
Office Tab bringt eine tabbasierte Oberfläche in Office und macht Ihre Arbeit viel einfacher
- Aktivieren Sie tabbasiertes Bearbeiten und Lesen in Word, Excel, PowerPoint, Publisher, Access, Visio und Project.
- Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters – statt jedes in einem separaten Fenster zu öffnen.
- Steigert Ihre Produktivität um 50 % und erspart Ihnen täglich Hunderte von Mausklicks!
Alle Kutools-Add-Ins – ein Installationsprogramm
Kutools for Office-Paket bündelt Add-Ins für Excel, Word, Outlook und PowerPoint sowie Office Tab Pro – ideal für Teams, die mit mehreren Office-Anwendungen arbeiten.
- Alles-in-einem-Paket— Add-Ins für Excel, Word, Outlook & PowerPoint sowie Office Tab Pro
- Ein Installationsprogramm, eine Lizenz— innerhalb weniger Minuten eingerichtet (MSI-fähig)
- Funktioniert besser zusammen— optimierte Produktivität über alle Office-Anwendungen hinweg
- 30-tägige Vollversion zum Testen— keine Registrierung, keine Kreditkarte erforderlich
- Bestes Preis-Leistungs-Verhältnis— sparen Sie im Vergleich zum Kauf einzelner Add-Ins