VBA Kombinieren Sie mehrere Excel-Dateien in einer Arbeitsmappe

Dieses Tutorial zeigt Ihnen, wie Sie in VBA mehrere Excel-Dateien zu einer Arbeitsmappe kombinieren

Das Erstellen einer einzelnen Arbeitsmappe aus einer Reihe von Arbeitsmappen mit VBA erfordert eine Reihe von Schritten.

• Sie müssen die Arbeitsmappen auswählen, aus denen Sie die Quelldaten möchten - die Quelldateien.
• Sie müssen die Arbeitsmappe auswählen oder erstellen, in die Sie die Daten einfügen möchten - die Zieldatei.
• Sie müssen die Blätter aus den gewünschten Quelldateien auswählen.
• Sie müssen dem Code mitteilen, wo die Daten in der Zieldatei platziert werden sollen.

Kombinieren aller Blätter aus allen geöffneten Arbeitsmappen zu einer neuen Arbeitsmappe als einzelne Blätter

Im folgenden Code müssen die Dateien, aus denen Sie die Informationen kopieren müssen, geöffnet sein, da Excel die geöffneten Dateien durchläuft und die Informationen in eine neue Arbeitsmappe kopiert. Der Code wird in die persönliche Makroarbeitsmappe eingefügt.

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

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Unter CombineMultipleFiles()Bei Fehler GoTo eh'Variablen deklarieren, um die erforderlichen Objekte aufzunehmenDim wbDestination als ArbeitsmappeDim wbSource als ArbeitsmappeDim wsSource als ArbeitsblattDim wb als ArbeitsmappeDim sh als ArbeitsblattDim strSheetName As StringDim strDestName As String'Schalte die Bildschirmaktualisierung aus, um die Dinge zu beschleunigenApplication.ScreenUpdating = False'Erste neue Zielarbeitsmappe erstellenSet wbDestination = Workbooks.Add'den Namen der neuen Arbeitsmappe abrufen, damit Sie sie aus der Schleife unten ausschließenstrDestName = wbDestination.Name'Schleife jetzt jede der geöffneten Arbeitsmappen durch, um die Daten abzurufen, aber schließe dein neues Buch oder die persönliche Makro-Arbeitsmappe ausFür jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" ThenSetze wbSource = wbFür jede sh in wbSource.Worksheetssh.Copy After:=Workbooks(strDestName).Sheets(1)Nächste shEnde WennNächstes wb'Schließen Sie jetzt alle geöffneten Dateien außer der neuen Datei und der persönlichen Makro-Arbeitsmappe.Für jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" Thenwb.Schließen FalschEnde WennNächstes wb'Blatt 1 aus der Zielarbeitsmappe entfernenApplication.DisplayAlerts = FalseSheets("Sheet1").LöschenApplication.DisplayAlerts = True'Räume die Objekte auf, um den Speicher freizugebenSetze wbDestination = NichtswbSource = Nichts setzenwsSource = Nichts setzenSetze wb = Nichts'Schalte die Bildschirmaktualisierung ein, wenn sie fertig istApplication.ScreenUpdating = FalseAbo beendenäh:MsgBox Err.BeschreibungEnd Sub

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

Ihre kombinierte Datei wird nun angezeigt.

Dieser Code hat jede Datei durchlaufen und das Blatt in eine neue Datei kopiert. Wenn eine Ihrer Dateien mehr als ein Blatt enthält, werden auch diese kopiert - einschließlich der Blätter ohne darauf!

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

Das folgende Verfahren kombiniert die Informationen aus allen Blättern in allen geöffneten Arbeitsmappen in einem einzelnen Arbeitsblatt in einer neuen Arbeitsmappe, die erstellt wird.

Die Informationen aus jedem Blatt werden in das Zielblatt in der letzten belegten Zeile des Arbeitsblatts eingefügt.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Unter CombineMultipleSheets()Bei Fehler GoTo eh'Variablen deklarieren, um die erforderlichen Objekte aufzunehmenDim wbDestination als ArbeitsmappeDim wbSource als ArbeitsmappeDim wsDestination As ArbeitsblattDim wb als ArbeitsmappeDim sh als ArbeitsblattDim strSheetName As StringDim strDestName As StringDim iRws As IntegeriCols als ganze Zahl dimmenDim totRws As IntegerDim strEndRng As StringDim rngSource als Bereich'Schalte die Bildschirmaktualisierung aus, um die Dinge zu beschleunigenApplication.ScreenUpdating = False'Erste neue Zielarbeitsmappe erstellenSet wbDestination = Workbooks.Add'den Namen der neuen Arbeitsmappe abrufen, damit Sie sie aus der Schleife unten ausschließenstrDestName = wbDestination.Name'jetzt durchlaufen Sie jede der geöffneten Arbeitsmappen, um die Daten abzurufenFür jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" ThenwbSource = wb . setzenFür jede sh in wbSource.Worksheets'Erhalte die Anzahl der Zeilen und Spalten im Arbeitsblattsh.AktivierenActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.Column'Legen Sie den Bereich der letzten Zelle im Blatt feststrEndRng = sh.Cells(iRws, iCols).Adresse'setze den Quellbereich zum Kopieren einSet rngSource = sh.Range("A1:" & strEndRng)'Finde die letzte Zeile im ZielblattwbDestination.AktivierenwsDestination = ActiveSheet festlegenwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'Überprüfen Sie, ob genügend Zeilen vorhanden sind, um die Daten einzufügenWenn totRws + rngSource.Rows.Count > wsDestination.Rows.Count ThenMsgBox "Es sind nicht genügend Zeilen vorhanden, um die Daten in das Konsolidierungsarbeitsblatt einzufügen."GoTo ehEnde Wenn'Füge eine Zeile hinzu, um sie in die nächste Zeile einzufügenWenn totRws 1 Dann totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)Nächste shEnde WennNächstes wb'Schließen Sie jetzt alle geöffneten Dateien außer der gewünschtenFür jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" Thenwb.Schließen FalschEnde WennNächstes wb'Räume die Objekte auf, um den Speicher freizugebenSetze wbDestination = NichtswbSource = Nichts setzenwsDestination = Nichts setzenSetze rngSource = NichtsSetze wb = Nichts'Schalte die Bildschirmaktualisierung ein, wenn sie fertig istApplication.ScreenUpdating = FalseAbo beendenäh:MsgBox Err.BeschreibungEnd Sub

Kombinieren aller Blätter aus allen geöffneten Arbeitsmappen zu einem einzigen Arbeitsblatt in einer aktiven Arbeitsmappe

Wenn Sie die Informationen aus allen anderen geöffneten Arbeitsmappen in diejenige übernehmen möchten, in der Sie gerade arbeiten, können Sie diesen Code unten verwenden.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Unter CombineMultipleSheetsToExisting()Bei Fehler GoTo eh'Variablen deklarieren, um die erforderlichen Objekte aufzunehmenDim wbDestination als ArbeitsmappeDim wbSource als ArbeitsmappeDim wsDestination As ArbeitsblattDim wb als ArbeitsmappeDim sh als ArbeitsblattDim strSheetName As StringDim strDestName As StringDim iRws As IntegeriCols als ganze Zahl dimmenDim totRws As IntegerDim rngEnd als StringDim rngSource als Bereich'Aktives Arbeitsmappenobjekt für das Zielbuch festlegenSetze wbDestination = ActiveWorkbook'den Namen der aktiven Datei abrufenstrDestName = wbDestination.Name'Schalte die Bildschirmaktualisierung aus, um die Dinge zu beschleunigenApplication.ScreenUpdating = False'Erstellen Sie zuerst ein neues Zielarbeitsblatt in Ihrer aktiven ArbeitsmappeApplication.DisplayAlerts = False'Nächsten Fehler fortsetzen, falls Tabellenblatt nicht vorhanden istBei Fehler Fortsetzen als nächstesActiveWorkbook.Sheets("Konsolidierung").Löschen'Fehlerfalle zurücksetzen, um am Ende zur Fehlerfalle zu gelangenBei Fehler GoTo ehApplication.DisplayAlerts = True'ein neues Blatt zur Arbeitsmappe hinzufügenMit ActiveWorkbookSet wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))wsDestination.Name = "Konsolidierung"Ende mit'jetzt jede der geöffneten Arbeitsmappen durchlaufen, um die Daten abzurufenFür jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" ThenSetze wbSource = wbFür jede sh in wbSource.Worksheets'bekomme die Anzahl der Zeilen im Blattsh.AktivierenActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells(iRws, iCols).AdresseSet rngSource = sh.Range("A1:" & rngEnd)'Finde die letzte Zeile im ZielblattwbDestination.AktivierenwsDestination = ActiveSheet festlegenwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'Überprüfen Sie, ob genügend Zeilen vorhanden sind, um die Daten einzufügenWenn totRws + rngSource.Rows.Count > wsDestination.Rows.Count ThenMsgBox "Es sind nicht genügend Zeilen vorhanden, um die Daten in das Konsolidierungsarbeitsblatt einzufügen."GoTo ehEnde Wenn'Füge eine Zeile zum Einfügen in die nächste Zeile hinzu, wenn du nicht in Zeile 1 bistWenn totRws 1 Dann totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)Nächste shEnde WennNächstes wb'Schließen Sie jetzt alle geöffneten Dateien außer der gewünschtenFür jedes wb in Application.WorkbooksWenn wb.Name strDestName und wb.Name "PERSONAL.XLSB" Thenwb.Schließen FalschEnde WennNächstes wb'Räume die Objekte auf, um den Speicher freizugebenSetze wbDestination = NichtswbSource = Nichts setzenSetze wsDestination = NichtsSetze rngSource = NichtsSetze wb = Nichts'Schalte die Bildschirmaktualisierung ein, wenn sie fertig istApplication.ScreenUpdating = FalseAbo beendenäh:MsgBox Err.BeschreibungEnd Sub