Tabellenblätter zusammenführen
✓ Tabellenblätter der ausgewählten Excel-Dateien mit einem Knopfdruck in einer Excel-Datei zusammenführen
✓ Tabellenblatt in eine neue Arbeitsmappe kopieren
✓ ScreenUpdating kurzzeitig deaktivieren
✓ Lokalfenster
✓ Benutzeroberfläche designen und Makro einem Button zuweisen
✓ Benutzer eine oder mehrere Dateien auswählen lassen
✓ Arrays
✓ If-Anweisung
✓ For-Next Schleife
✓ For-Each SChleife
✓ Variablen und Datentypen ✓ Arbeitsmappen öffnen und schließen
✓ Tabellenblatt in eine neue Arbeitsmappe kopieren
✓ ScreenUpdating kurzzeitig deaktivieren
✓ Lokalfenster
✓ Benutzeroberfläche designen und Makro einem Button zuweisen
✓ Benutzer eine oder mehrere Dateien auswählen lassen
✓ Arrays
✓ If-Anweisung
✓ For-Next Schleife
✓ For-Each SChleife
✓ Variablen und Datentypen ✓ Arbeitsmappen öffnen und schließen
Code
Sub Dateien_zusammenfuehren()
'Führt alle Tabellenblätter der ausgewählten Excel-Dateien in dieser Arbeitsmappe zusammen
Dim wbQuelle As Workbook
Dim sh As Worksheet
Dim arrdateien As Variant
Dim cntDatei As Long
'Screenupdating deaktivieren
Application.ScreenUpdating = False
'Benutzer Dateien auswählen lassen
arrdateien = Application.GetOpenFilename(filefilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
'Wurde mindestens eine Datei ausgewählt?
If IsArray(arrdateien) Then
'Schleife über alle ausgewählten Dateien
For cntDatei = 1 To UBound(arrdateien)
'Aktuelle Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrdateien(cntDatei), UpdateLinks:=False, ReadOnly:=True)
'Schleife über alle Tabellenblätter
For Each sh In wbQuelle.Worksheets
'Aktuelles Tabellenblatt kopieren
sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next sh
'Aktuelle Arbeitsmappe schließen
wbQuelle.Close savechanges:=False
Next cntDatei
End If
'Screenupdating aktivieren
Application.ScreenUpdating = True
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub
Sub Dateien_zusammenfuehren()
'Führt alle Tabellenblätter der ausgewählten Excel-Dateien in dieser Arbeitsmappe zusammen
Dim wbQuelle As Workbook
Dim sh As Worksheet
Dim arrdateien As Variant
Dim cntDatei As Long
'Screenupdating deaktivieren
Application.ScreenUpdating = False
'Benutzer Dateien auswählen lassen
arrdateien = Application.GetOpenFilename(filefilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
'Wurde mindestens eine Datei ausgewählt?
If IsArray(arrdateien) Then
'Schleife über alle ausgewählten Dateien
For cntDatei = 1 To UBound(arrdateien)
'Aktuelle Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrdateien(cntDatei), UpdateLinks:=False, ReadOnly:=True)
'Schleife über alle Tabellenblätter
For Each sh In wbQuelle.Worksheets
'Aktuelles Tabellenblatt kopieren
sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next sh
'Aktuelle Arbeitsmappe schließen
wbQuelle.Close savechanges:=False
Next cntDatei
End If
'Screenupdating aktivieren
Application.ScreenUpdating = True
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub
Sub Dateien_zusammenfuehren()
'Führt alle Tabellenblätter der ausgewählten Excel-Dateien in dieser Arbeitsmappe zusammen
Dim wbQuelle As Workbook
Dim sh As Worksheet
Dim arrdateien As Variant
Dim cntDatei As Long
'Screenupdating deaktivieren
Application.ScreenUpdating = False
'Benutzer Dateien auswählen lassen
arrdateien = Application.GetOpenFilename(filefilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
'Wurde mindestens eine Datei ausgewählt?
If IsArray(arrdateien) Then
'Schleife über alle ausgewählten Dateien
For cntDatei = 1 To UBound(arrdateien)
'Aktuelle Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrdateien(cntDatei), UpdateLinks:=False, ReadOnly:=True)
'Schleife über alle Tabellenblätter
For Each sh In wbQuelle.Worksheets
'Aktuelles Tabellenblatt kopieren
sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next sh
'Aktuelle Arbeitsmappe schließen
wbQuelle.Close savechanges:=False
Next cntDatei
End If
'Screenupdating aktivieren
Application.ScreenUpdating = True
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub