Note: The other languages of the website are Google-translated. Back to English

Wie durchlaufe ich Dateien in einem Verzeichnis und kopiere Daten in ein Masterblatt in Excel?

Angenommen, ein Ordner enthält mehrere Excel-Arbeitsmappen, und Sie möchten alle diese Excel-Dateien durchlaufen und Daten aus einem bestimmten Bereich gleichnamiger Arbeitsblätter in ein Master-Arbeitsblatt in Excel kopieren. Was können Sie tun? In diesem Artikel wird eine Methode vorgestellt, mit der dies im Detail erreicht werden kann.

Durchlaufen Sie Dateien in einem Verzeichnis und kopieren Sie Daten mit VBA-Code in ein Masterblatt


Durchlaufen Sie Dateien in einem Verzeichnis und kopieren Sie Daten mit VBA-Code in ein Masterblatt

Wenn Sie bestimmte Daten im Bereich A1: D4 von allen Arbeitsblättern1 in einem bestimmten Ordner in ein Masterblatt kopieren möchten, gehen Sie wie folgt vor.

1. Drücken Sie in der Arbeitsmappe ein Master-Arbeitsblatt und drücken Sie die Taste Andere + F11 Schlüssel zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. In dem Microsoft Visual Basic für Applikationen Klicken Sie im Fenster Insert > Modul. Kopieren Sie dann den folgenden VBA-Code in das Codefenster.

VBA-Code: Durchlaufen Sie die Dateien in einem Ordner und kopieren Sie die Daten in ein Masterblatt

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 Sub

Hinweis:

1). Im Code „A1: D4" und "Sheet1”Bedeutet, dass Daten im Bereich A1: D4 aller Blätter1 in das Masterblatt kopiert werden. Und "Neues Blatt”Ist der Name des neu erstellten Masterblatts.
2). Die Excel-Dateien im jeweiligen Ordner sollten nicht geöffnet werden.

3. Drücken Sie die Taste F5 Schlüssel zum Ausführen des Codes.

4. In der Öffnung Entdecken Wählen Sie im Fenster den Ordner mit den Dateien aus, die Sie durchlaufen möchten, und klicken Sie dann auf OK Taste. Siehe Screenshot:

Anschließend wird am Ende der aktuellen Arbeitsmappe ein Master-Arbeitsblatt mit dem Namen „Neues Blatt“ erstellt. Die Daten im Bereich A1: D4 aller Blätter1 im ausgewählten Ordner werden im Arbeitsblatt aufgelistet.


In Verbindung stehende Artikel:


Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten
Kommentare (20)
Noch keine Bewertungen. Bewerten Sie als Erster!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
danke für den vba-code! Es funktioniert perfekt! Möchten Sie wissen, wie der Code lautet, wenn ich stattdessen ALS WERT EINFÜGEN muss? Thx im Voraus!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo LaiLing,
Der folgende Code kann Ihnen helfen, das Problem zu lösen. Danke für deinen Kommentar.

SubMerge2MultiSheets()
Dim xRg als Bereich
Dim xSelItem als Variante
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook als Arbeitsmappe
Dim xSheet als Arbeitsblatt
On Error Resume Next
Application.DisplayAlerts = Falsch
Application.EnableEvents = Falsch
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Mit xFileDlg
Wenn .Show = -1 Dann
xSelItem = .SelectedItems.Item(1)
Legen Sie xWorkBook = DieseArbeitsmappe fest
Setze xSheet = xWorkBook.Sheets("Neues Blatt")
Wenn xSheet dann nichts ist
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = „Neues Blatt“
Setze xSheet = xWorkBook.Sheets("Neues Blatt")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Wenn xFileName = "" dann Sub beenden
Tun bis xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Setze xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xDateiname = Dir()
xBook.Close
Loop
End If
Ende mit
Setzen Sie xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = True
xRg.UseStandardWidth = True
Application.DisplayAlerts = True
Application.EnableEvents = Wahr
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, danke für den Code. Können Sie mir bitte mitteilen, wie ich den Excel-Dateinamen einfügen kann, aus dem der Datenbereich kopiert wurde? Das wäre eine große Hilfe!

Danke.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo,

Vielen Dank für das Tutorial.

Wie würde ich: Kopieren Sie nur die Zeile in "Sheet1" mit Werten aus der Zeile "Total" und fügen Sie sie mit [Dateiname] in das Master-Arbeitsblatt mit dem Namen "New Sheet" ein. Das Notieren der Zeile mit Summe kann in jedem Arbeitsblatt unterschiedlich sein.

Beispielsweise:
Datei1: Blatt1
Col1, Col2, Colx
1,2,15
Ergebnis 10,50

Datei2: Blatt1
Col1, Col2, Colx
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Ergebnis 300,500

MasterFile: "Neues Blatt":
Datei1, 10, 50
Datei2, 300, 500
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, das funktioniert super. Gibt es eine Möglichkeit zu ändern, um nur die Werte und nicht die Formel zu ziehen?
Vielen Dank!!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Trish,
Der folgende Code kann Ihnen helfen, das Problem zu lösen. Danke für deinen Kommentar.

SubMerge2MultiSheets()
Dim xRg als Bereich
Dim xSelItem als Variante
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook als Arbeitsmappe
Dim xSheet als Arbeitsblatt
On Error Resume Next
Application.DisplayAlerts = Falsch
Application.EnableEvents = Falsch
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Mit xFileDlg
Wenn .Show = -1 Dann
xSelItem = .SelectedItems.Item(1)
Legen Sie xWorkBook = DieseArbeitsmappe fest
Setze xSheet = xWorkBook.Sheets("Neues Blatt")
Wenn xSheet dann nichts ist
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = „Neues Blatt“
Setze xSheet = xWorkBook.Sheets("Neues Blatt")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Wenn xFileName = "" dann Sub beenden
Tun bis xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Setze xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xDateiname = Dir()
xBook.Close
Loop
End If
Ende mit
Setzen Sie xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = True
xRg.UseStandardWidth = True
Application.DisplayAlerts = True
Application.EnableEvents = Wahr
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, es zieht immer noch die Formeln, nicht die Werte, also gibt es mir einen #REF-Fehler. Ich weiß, dass es irgendwo ein .PasteSpecial xlPasteValues ​​braucht, aber ich kann nicht herausfinden, wo. Kannst du helfen? Vielen Dank!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Danke dafür.


Wie füge ich den Code ein, um alle Ordner und Unterordner zu durchlaufen und die obige Kopie durchzuführen?


Vielen Dank!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo - Dieser Code ist perfekt für das, was ich erreichen möchte.

Gibt es eine Möglichkeit, alle Ordner und Unterordner zu durchlaufen und die Kopie durchzuführen?


Vielen Dank!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo - Dieser Code funktioniert sehr gut für die ersten 565 Zeilen für jede Datei, aber alle Zeilen danach werden von der nächsten Datei überlappt.
Gibt es eine Möglichkeit, dies zu beheben?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Vielen Dank - wie könnte man (Sonderwerte) aus jedem Arbeitsblatt innerhalb einer Arbeitsmappe in separate Blätter innerhalb einer Haupt-Master-Datei kopieren und einfügen?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wie bringt man Code dazu, ein Leerzeichen zu lassen, wenn die Zelle leer ist?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Bei mir ändert sich der Name der Registerkarte "Sheet1" für jede meiner Dateien. Zum Beispiel Tab1, Tab2, Tab3, Tab4 ... Wie kann ich eine Schleife einrichten, um eine Liste in Excel zu durchlaufen und den Namen "Sheet1" so lange zu ändern, bis er alles durchläuft?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Nick, der folgende VBA-Code kann Ihnen helfen, das Problem zu lösen. Bitte versuchen Sie es. Unter LoopThroughFileRename()
'Aktualisiert von Extendofice 2021/12/31
Dim xRg als Bereich
Dim xSelItem als Variante
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook als Arbeitsmappe
Dim xSheet als Arbeitsblatt
Dim xShs als Blätter
Dim xName als Zeichenfolge
Dim xFNum als ganze Zahl
On Error Resume Next
Application.DisplayAlerts = Falsch
Application.EnableEvents = Falsch
Application.ScreenUpdating = False
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xFileDlg.Show
xSelItem = xFileDlg.SelectedItems.Item(1)
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Do While xFileName <> ""
Setze xWorkBook = Workbooks.Open(xSelItem & "\" & xFileName)
Legen Sie xShs = xWorkBook.Sheets fest
Für xFNum = 1 bis xShs.Count
Setze xSheet = xShs.Item(xFNum)
xName = xSheet.Name
xName = Ersetzen (xName, "Blatt""Tab") 'Blatt durch Tab ersetzen
xSheet.Name = xName
Weiter
xWorkBook.Speichern
xWorkBook.Schließen
xDateiname = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = Wahr
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, ich möchte einen Code, um die Daten in 6 verschiedenen Arbeitsmappen (in einem Ordner) zu kopieren, in denen Blätter in NEW WORKBOOK enthalten sind. im VB
Bitte helfen Sie mir asp
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Paranusha,
Das VBA-Skript im folgenden Artikel kann mehrere Arbeitsmappen oder bestimmte Blätter von Arbeitsmappen zu einer Master-Arbeitsmappe kombinieren. Bitte überprüfen Sie, ob es helfen kann.
Wie kombiniere ich mehrere Arbeitsmappen in einer Master-Arbeitsmappe in Excel?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Olá bom dia.
Gostei muito dessde código, mas não me ajudou com os relatórios que eu preciso impreimir.
Preciso imprimir 2.400 relatório de exel que estão em pastas differentes e não estão configuradas corretamente para impressão. Pode me enviar um códgo de VBA que automatize essas impressões ? Me ajudaria muito, obrigada.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Maria Soares,
Bitte überprüfen Sie, ob der VBA-Code im folgenden Beitrag hilfreich sein kann.
Wie drucke ich mehrere Arbeitsmappen in Excel?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Mein Szenario ist ähnlich, außer dass ich mehrere Blätter in jeder Datei habe, alle mit unterschiedlichen Namen, aber konsistent zwischen den Dateien. Gibt es eine Möglichkeit, diesen Code zu loopen, um die Daten in den Dateien zu kopieren und (Werte) in bestimmte Blattnamen in der Master-Arbeitsmappe einzufügen? Die Blattnamen im Master sind die gleichen wie in den Dateien. Ich möchte sie durchschleifen. Außerdem variiert die Datenmenge in jedem Blatt, daher muss ich die Daten in jedem Blatt folgendermaßen auswählen:

Bereich ("A1").Auswählen
Bereich (Auswahl, Auswahl.End (xlDown))
Range(Selection, Selection.End(xlToRight)).Select


Dateiblattnamen sind Spenden, Dienstleistungen, Versicherung, Auto, Sonstige Ausgaben usw.

Vielen Dank im Voraus.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Andreas Shahan,
Der folgende VBA-Code kann Ihr Problem lösen. Nachdem Sie den Code ausgeführt und einen Ordner ausgewählt haben, gleicht der Code das Arbeitsblatt automatisch nach Namen ab und fügt die Daten in das gleichnamige Arbeitsblatt in der Master-Arbeitsmappe ein.
Sub Merge2MultiSheets()
'Updated by Extendoffice 20221209
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook As Workbook, xMainBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set xMainBook = ThisWorkbook
    
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            
            Do Until xFileName = ""
            Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)

            For Start = 1 To xBook.Worksheets.Count
                Set xSheet = xBook.Worksheets.Item(Start)
                xSheet.Activate
                xSheetName = xSheet.Name
                xSheet.UsedRange.Copy (xMainBook.Worksheets.Item(xSheetName).Range("A1048576").End(xlUp).Offset(1, 0))
            Next
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Es sind noch keine Kommentare vorhanden

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL