VBA – Mehrere Excel-Dateien in einer Arbeitsmappe zusammenführen

In diesem Tutorial erfahren Sie, wie Sie mit VBA mehrere Excel-Dateien in einer Arbeitsmappe zusammenführen.

Das Erstellen einer einzigen Arbeitsmappe aus mehreren Arbeitsmappen mit VBA erfordert eine Reihe von Schritten, die befolgt werden müssen.

• Sie müssen die Arbeitsmappen auswählen, aus denen Sie die Quelldaten beziehen möchten (die Quelldateien).
• Sie müssen die Arbeitsmappe auswählen oder erstellen, in die Sie die Daten eingeben möchten (die Zieldatei).
• Sie müssen die benötigten Blätter aus den Quelldateien auswählen.
• Sie müssen dem Code mitteilen, wo die Daten in der Zieldatei abgelegt werden sollen.

Zusammenführen aller Blätter aus allen geöffneten Arbeitsmappen in einer neuen Arbeitsmappe als Einzelblätter

Im folgenden Code müssen die Dateien, aus denen Sie die Informationen kopieren möchten, geöffnet sein, da Excel die geöffneten Dateien in einer Schleife durchläuft und die Informationen in eine neue Arbeitsmappe kopiert. Der Code befindet sich in der Makro-Arbeitsmappe PERSONAL.xlsb.

Diese Dateien sind die EINZIGEN Excel-Dateien, die geöffnet sein sollten.

Sub MehrereDateienZusammenfuehren()
On Error GoTo eh
'Variablen deklarieren, um die erforderlichen Objekte zu speichern.
   Dim wbZiel As Workbook
   Dim wbQuelle As Workbook
   Dim wsQuelle As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strBlattName As String
   Dim strZielName As String
'Die Bildschirmaktualisierung deaktivieren, um die Ausführung zu beschleunigen.
   Application.ScreenUpdating = False
'Zuerst neue Zielarbeitsmappe erstellen.
   Set wbZiel = Workbooks.Add
'Den Namen der neuen Arbeitsmappe ermitteln, um sie aus der nachfolgenden Schleife auszuschließen.
   strZielName = wbZiel.Name
'Nun alle geöffneten Arbeitsmappen in einer Schleife durchlaufen, um die Daten abzurufen, aber die neue Arbeitsmappe oder die Makro-Arbeitsmappe PERSONAL.xlsb ausschließen.
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbQuelle = wb
         For Each sh In wbQuelle.Worksheets
            sh.Copy After:=Workbooks(strZielName).Sheets(1)
         Next sh
      End If
   Next wb
'Nun alle geöffneten Dateien mit Ausnahme der neuen Datei und der Makro-Arbeitsmappe PERSONAL.xlsb schließen.
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb

'Blatt eins aus der Zielarbeitsmappe entfernen.
   Application.DisplayAlerts = False
   Sheets("Tabelle1").Delete
   Application.DisplayAlerts = True
'die Objekte aufräumen, um den Speicher freizugeben.
   Set wbZiel = Nothing
   Set wbQuelle = Nothing
   Set wsQuelle = Nothing
   Set wb = Nothing
'Die Bildschirmaktualisierung einschalten, wenn die Ausführung abgeschlossen ist.
   Application.ScreenUpdating = False
Exit Sub
eh:
   MsgBox Err.Description
End Sub

Klicken Sie auf das Makro-Dialogfeld, um die Prozedur von Ihrem Excel-Bildschirm aus auszuführen.

Ihre zusammengeführte Datei wird nun angezeigt.

Dieser Code hat  jede Datei in einer Schleife durchlaufen und das Blatt in die neue Datei kopiert. Wenn eine Ihrer Dateien mehr als ein Blatt enthält, werden auch diese kopiert (einschließlich der Blätter, auf denen sich nichts befindet!).

Zusammenführen aller Blätter aus allen geöffneten Arbeitsmappen zu einem einzigen Arbeitsblatt in einer neuen Arbeitsmappe

Das folgende Verfahren führt die Informationen aus allen Blättern aller geöffneten Arbeitsmappen in einem einzigen Arbeitsblatt in einer neu erstellten Arbeitsmappe zusammen.

Die Informationen aus jedem Blatt werden in die letzte belegte Zeile des Zielblattes eingefügt.

Sub MehrereArbeitsblaetterZusammenfuehren()
On Error GoTo eh
'Variablen deklarieren, um die erforderlichen Objekte zu speichern
   Dim wbZiel As Workbook
   Dim wbQuelle As Workbook
   Dim wsZiel As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strBlattName As String
   Dim strZielName As String
   Dim iZeilen As Integer
   Dim iSpalten As Integer
   Dim bisZeilen As Integer
   Dim strEndBereich As String
   Dim rngQuelle As Range
'Die Bildschirmaktualisierung ausschalten, um die Ausführung zu beschleunigen.
   Application.ScreenUpdating = False
'Zuerst eine neue Zielarbeitsmappe anlegen
   Set wbZiel = Workbooks.Add
'Den Namen der neuen Arbeitsmappe ermitteln, um sie aus der nachfolgenden Schleife auszuschließen
   strZielName = wbZiel.Name
'Nun alle geöffneten Arbeitsmappen in einer Schleife durchlaufen, um die Daten zu ermitteln
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbQuelle = wb
         For Each sh In wbQuelle.Worksheets
'Die Anzahl der Zeilen und Spalten im Blatt ermitteln
            sh.Activate
            ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
            iZeilen = ActiveCell.Row
            iSpalten = ActiveCell.Column
'Den Bereich der letzten Zelle im Blatt festlegen
            strEndBereich = sh.Cells(iZeilen, iSpalten).Address
'Den zu kopierenden Quellbereich festlegen
            Set rngQuelle = sh.Range("A1:" & strEndBereich)
'Die letzte Zeile im Zielblatt suchen
           wbZiel.Activate
           Set wsZiel = ActiveSheet
           wsZiel.Cells.SpecialCells(xlCellTypeLastCell).Select
           bisZeilen = ActiveCell.Row
'Prüfen, ob genügend Zeilen zum Einfügen der Daten vorhanden sind.
           If bisZeilen + rngQuelle.Rows.Count > wsZiel.Rows.Count Then
               MsgBox "Es sind nicht genügend Zeilen vorhanden, um die Daten in das Konsolidierungsarbeitsblatt einzufügen."
               GoTo eh
           End If
'Eine Zeile hinzufügen, um sie in die nächste Zeile einzufügen
           If bisZeilen <> 1 Then bisZeilen = bisZeilen + 1
           rngQuelle.Copy Destination:=wsZiel.Range("A" & bisZeilen)
      Next sh
   End If
   Next wb
'Nun alle geöffneten Dateien außer der gewünschten Datei schließen
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb
'die Objekte aufräumen, um den Speicher freizugeben
   Set wbZiel = Nothing
   Set wbQuelle = Nothing
   Set wsZiel = Nothing
   Set rngQuelle = Nothing
   Set wb = Nothing
'Bildschirmaktualisierung nach Abschluss einschalten
   Application.ScreenUpdating = False
Exit Sub
eh:
MsgBox Err.Description
End Sub

Zusammenführen aller Blätter aus allen geöffneten Arbeitsmappen in einem einzigen Arbeitsblatt in der aktuellen Arbeitsmappe

Sub MehrereBlaetterInBestehenderMappeZusammenfuehren()
  On Error GoTo eh
'Variablen deklarieren, um die erforderlichen Objekte zu speichern.
   Dim wbZiel As Workbook
   Dim wbQuelle As Workbook
   Dim wsZiel As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strBlattName As String
   Dim strZielName As String
   Dim iZeilen As Integer
   Dim iSpalten As Integer
   Dim bisZeilen As Integer
   Dim rngEnde As String
   Dim rngQuelle As Range
'Die aktuelle Arbeitsmappe als Zielmappe festlegen.
   Set wbZiel = ActiveWorkbook
'den Namen der aktellen Datei ermitteln.
   strZielName = wbZiel.Name
'die Bildschirmaktualisierung ausschalten, um die Ausführung zu beschleunigen
   Application.ScreenUpdating = False
'Zunächst ein neues Zielarbeitsblatt in Ihrer aktuellen Arbeitsmappe erstellen.
   Application.DisplayAlerts = False
'Fortsetzen, falls das Blatt nicht existiert (Resume Next).
   On Error Resume Next
ActiveWorkbook.Sheets("Konsolidierung").Delete
'Zurücksetzen der Fehlerfalle, um zur Fehlerfalle am Ende zu gelangen.
   On Error GoTo eh
Application.DisplayAlerts = True
'Der Arbeitsmappe ein neues Blatt hinzufügen.
   With ActiveWorkbook
      Set wsZiel = .Sheets.Add(After:=.Sheets(.Sheets.Count))
      wsZiel.Name = "Konsolidierung"
   End With
'Nun alle geöffneten Arbeitsmappen in einer Schleife durchlaufen, um die Daten zu ermitteln.
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbQuelle = wb
            For Each sh In wbQuelle.Worksheets
'Die Anzahl der Zeilen im Blatt ermitteln.
                sh.Activate
                ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
                iZeilen = ActiveCell.Row
                iSpalten = ActiveCell.Column
                rngEnde = sh.Cells(iZeilen, iSpalten).Address
                Set rngQuelle = sh.Range("A1:" & rngEnde)
'Die letzte Zeile im Zielblatt finden.
                wbZiel.Activate
                Set wsZiel = ActiveSheet
                wsZiel.Cells.SpecialCells(xlCellTypeLastCell).Select
                bisZeilen = ActiveCell.Row
'Prüfen, ob genügend Zeilen vorhanden sind, um die Daten einzufügen.
                If bisZeilen + rngQuelle.Rows.Count > wsZiel.Rows.Count Then
                   MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
                   GoTo eh
                End If
'Eine Zeile zum Einfügen in der nächsten Zeile hinzufügen, wenn Sie sich nicht in Zeile 1 befinden.
                If bisZeilen <> 1 Then bisZeilen = bisZeilen + 1
                   rngQuelle.Copy Destination:=wsZiel.Range("A" & bisZeilen)
            Next sh
      End If
   Next wb
'Nun alle geöffneten Dateien mit Ausnahme der gewünschten Datei schließen.
   For Each wb In Application.Workbooks
      If wb.Name <> strZielName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb

'Die Objekte löschen, um den Speicher zu leeren.
   Set wbZiel = Nothing
   Set wbQuelle = Nothing
   Set wsZiel = Nothing
   Set rngQuelle = Nothing
   Set wb = Nothing
'Die Bildschirmaktualisierung einschalten, wenn die Ausführung abgeschlossen ist.
   Application.ScreenUpdating = False
Exit Sub
eh:
MsgBox Err.Description

End Sub

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro - A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!


Learn More!