Für Auswertungen in Excel kann es nötig sein, auf verschiedene Quellen zuzugreifen. Die eine Möglichkeit wäre, die benötigten Tabellen miteinander zu verknüfen (siehe dazu auch meinen Artikel "Tabellen verknüpfen"). Wenn die Dateien alle in demselben Ordner liegen, kann man die in dem Artikel "Mehrere Tabellen z.B. aus einem Ordner einlesen" genannten Methoden nutzen. Alternativen dazu beschreibe ich in diesem Artikel.

Der Hauptgrund, verschiedene Excel-Tabellen aneinanderzuhängen, ist, dass eine Zentrale gleichartige Berichte von z.B. Tochterfirmen oder Abteilungen bekommt, welche dann zusammengefasst werden müssen. Das Ergebnis kann für dieverse Auswertungen genutzt werden. Das kann über grafische Darstellungen wie Management Dashboards oder Controlling Cockpits bzw. Pivot- oder OLAP-Auswertungen passieren.

Es gibt verschiedene Möglichkeiten, die Tabellen entsprechend zusammenzufügen. Hier stelle ich einige davon vor: eine mit VBA und die anderen mithilfe von Power Query.

Voraussetzung

Es ist eigentlich trivial: Wenn man diverse Tabellen aneinanderfügen möchte, macht es nicht viel Sinn, vollkommen unterschiedliche Dateien zu nehmen. Die Tabellen sollten tatsächlich gleichartig sein, also dieselben Felder in der gleichen Anordnung haben.

Power Query – Anfügen

Beispiel für den Power Query Editor im Einsatz

Die anzufügenden Tabellen liegen in jeweils eigenen Dateien vor. In die Zieltabelle lädt man sie ein über Daten – Daten abrufen und transformieren – Aus Datei – Aus Arbeitsmappe. Man wählt zuerst die Datei und danach die interessierende Tabelle aus. Im Prüffeld wählen wir „Transformieren“ und prüfen, ob die Daten alle korrekt formatiert sind, das gilt besonders für Datumsangaben. Ist das nicht der Fall, kann man prüfen, ob ein im rechten Fenster (Abb. 1, blau eingerahmt) dargestellter früherer Verlaufsschritt zu besseren Ergebnissen führt, indem man einfach daraufklickt. Dann werden die nachfolgenden Schritte einfach ignoriert. Wenn das der Fall ist, löschen wir die späteren, untenstehenden, Schritte. Wenn nicht, ändern wir den Datentyp. Im Menüband finden wir dazu unter Start – Transformieren das Drop-Down-Feld „Datentyp“ (Abb.1, rote Linie). Wenn man allerdings ein Eingabeformular verwendet, in welchem bestimmte Spalteninhalte errechnet werden, dann legt man vorsichtshalber mehr Zeilen an, als man erwartet. In diesen überschüssigen Zeilen stehen dann in den berechneten Zellen Formeln die sozusagen „ins Leere“ gehen (erkennbar am #NV). Diese Zeilen eliminiert man einfach durch Filtern. Wenn wir mit der Darstellung der einzelnen Felder zufrieden sind, gehen wir ganz links auf das kleine Dreieck unter Start – Schließen – Schließen & Laden (Abb.1., Schwarze Linie). Dort wählen wir Schließen & Laden in … - Nur Verbindung erstellen.

Auf diese Weise binden wir alle relevanten Tabellen ein, ohne sie auf einem Tabellenblatt darzustellen. Wenn wir das getan haben, sind im Menüband 2 weitere Optionen verfügbar: Tabellen- und Abfragetools. Wir wählen Abfragetools – Anfügen (Abb. 2, rote und schwarze Umrandungen). Dort wählen wir das Zutreffende aus und bestätigen wieder mit „Schließen & Laden“. Die Ergebnistabelle wird „Anfügen1“ genannt, das können wir bei Tabellentools – Entwurf – Eigenschaften – Tabellenname ändern. Jetzt sollte auch rechts das Abfragen- und Verbindungsfenster geöffnet sein, in dem alle vorhandenen Tabellen und Abfragen aufgelistet sind (siehe auch Abb. 2, Bereich an der unteren rechten Seite).

Es gibt spezielle Möglichkeiten dafür, gleich aufgebaute Tabellen, die sich in einem speziellen Ordner befinden, einzulesen. Die beschreibe ich im Artikel "Tabellen aus einem Ordner einfügen".

Selbst erstelltes Excel Formular, um eine VBA Routine zu steuern

Anfügen über eine VBA-Routine

Natürlich kann man auch mittels VBA Tabellen einlesen. Das hat z.B. den Vorteil, dass wir wie im gezeigten Steuerungsblatt, verschiedene Vorgaben vom Benutzer erlauben können. Damit haben wir hier eine Möglichkeit, diverse Tabellen von Mitarbeitern einlesen zu lassen, die keine Excel-Experten sind.

In der im Folgenden vorgestellten VBA-Routine gehen wir von folgenden Prämissen aus:

Die Dateien sind allesamt gleich aufgebaut.
In Spalte B sind ausschließlich eingegebene Daten vorhanden, keine berechneten Zellen mit einer Fehlermeldung wie „#NV“.
Es gibt ein Steuerungsblatt (Abb. 4) mit 2 Eingabezellen: für den Pfad und für die Anzahl der erwarteten Dateien. Letztere hat u.a. folgenden Sinn: die über VBA erzeugte Datei wird in genau diesen Ordner geschrieben. Haben wir vergessen, sie zu löschen oder in einen anderen Ordner zu verschieben, erhalten wir eine Verdopplung der Daten.
Natürlich ist auch eine Schaltfläche vorhanden, welche die nachfolgende VBA-Routine startet.

VBA-Listing

Option Explicit

Option Compare Text

' ********************************************************************************************

'Erstellt 2020 von Dr. Udo Baumfalk

'Dies Modul hat im Wesentlichen 2 Aufgaben:

'Die (Namen der) Dateien eines Verzeichnisses zu erfassen und dann

'den Inhalt dieser Dateien hintereinander einzulesen.

' *********************************************************************************************

Public sRootPath As String

Public DatName As String 'Name der aktuell ausgewählten Datei

Public DatZahl As Integer 'Ist-Anzahl der Dateien

Public WBZiel As Workbook

Dim DatSoll As Byte 'Soll-Anzahl der Dateien

Dim ZU As String 'Zeilenumbruch in den Botschaften

Public oFolder As Object

Public oFile As Object

Public oFSO As Object

Public WSZiel As Worksheet 'Ziel-Worksheet

Public WBZ As Workbook 'Ziel-Workbook

Public WSQuell As Worksheet 'Quell-Worksheet

Private lRowCounter As Long

Private oSheet As Object

'*************************************************************************************************

'Diese Sub ist die Klammer für alle Aufgaben, von hier aus werden also die Subroutinen aufgerufen.

'Natürlich findet hier auch die Vorbereitung statt.

'*************************************************************************************************

Public Sub Klammer()

Dim Botschaft As String

Dim DatumH, JahrH

Dim Box As String

Dim WBName As String

Dim NewBook As Workbook

ZU = Chr(10) 'Zeichen für Zeilenumbruch, nötig für die Botschaften an die Nutzer

'Makro beschleunigen und für Anwender angenehmer machen (z.B. kein Flimmern)

Application.DisplayAlerts = False

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.EnableEvents = False

End With

'Informationsbox, nur wenn der Pfad eingegeben wurde, startet das Programm

Botschaft = "Hiermit werden die korrigierten Dateien der Einzelverbände eingelesen. " + ZU + _

"Dazu muss der komplette Pfad für den Ordner, in dem diese Dateien liegen, in die Zelle B4 eingegeben werden. " _

+ ZU + "Am Besten kopieren Sie ihn aus dem Explorer in diese Zelle. " + ZU + ZU + _

"Zusätzlich tragen Sie bitte die Zahl der Verbände, welche Daten schicken sollen, in die Zelle D4 ein." + ZU + ZU + _

"Wenn Sie das getan haben, bestätigen Sie bitte mit JA, sonst drücken Sie NEIN."

Box = MsgBox(Botschaft, vbYesNo, "Information")

If Box = vbNo Then

Call Abschluss

Exit Sub 'Programmabbruch

End If

Range("D4").Select

DatSoll = Selection.Value

If DatSoll = 0 Then

Botschaft = "Es wurde keine erwartete Anzehl von Dateien eingegeben!" + ZU + _

"Holen Sie das bitte nach und starten dann neu."

Box = MsgBox(Botschaft, vbExclamation, "Abbruch")

Call Abschluss

Exit Sub 'Programmabbruch

End If

Range("B4").Select 'Dort sollte der Dateipfad eingetragen werden

sRootPath = Selection.Value 'Liest den Dateipfad in die Variable ein

If sRootPath = "" Then

Botschaft = "Es wurde kein Pfad eingetragen. " + ZU + _

"Holen Sie das bitte nach und starten dann neu"

Box = MsgBox(Botschaft, vbExclamation, "Abbruch")

Call Abschluss

Exit Sub

End If

'Jetzt geht's richtig los!

Application.StatusBar = "Vorbereitung"

Set WBZiel = ActiveWorkbook

Set oSheet = Sheets.Add 'Neues Blatt einfügen, auf das werden die Dateinamen geschrieben

oSheet.Activate

ActiveSheet.Name = "Liste"

oSheet.Cells(1, 1).Select

Call HilfsUeberschriften 'diese Routine erzeugt und formatiert die Überschriften

lRowCounter = 2

Call Pfade_Lesen(sRootPath) 'ruft die Routine zum Auslesen der Unterordner und Dateien auf

'Set oSheet = Nothing

DatZahl = lRowCounter - 2 'Das ist die Anzahl der gefundenen Dateien

If DatZahl = DatSoll Then

Botschaft = "Es sind " & DatZahl & " Dateien geschickt worden, also alle."

Box = MsgBox(Botschaft, vbOKOnly, "Anzahl der Dateien")

Else

Botschaft = "Es sind " & DatZahl & " Dateien geschickt worden, also nicht die geforderte Anzahl von " & DatSoll & _

ZU + "Bitte fügen Sie die Dateien erst zusammen, wenn alle da sind."

Box = MsgBox(Botschaft, vbOKOnly, "Anzahl der Dateien")

Call Abschluss

Exit Sub

End If

Sheets.Add 'Fügt die Tabelle hinzu, in die die Gesamtdaten aufgenommen werden

ActiveSheet.Name = "LEB_gesamt" 'Benennt diese Tabelle

Call ZielUeberschriftenNeu 'Erstellt die Überschriften der Zieltabelle

Set WSZiel = ActiveWorkbook.ActiveSheet

Call Daten_lesen_neu

'**********************

'Die neuen Daten werden in ein neues Arbeitsblatt geschrieben und gespeichert

'**********************

DatumH = Now()

JahrH = Year(DatumH) - 1

WBName = sRootPath & "\LEB_Gesamt_" & JahrH & ".xlsx" 'Pfad und Name, unter dem die neue Datei gespeichert werden soll

Workbooks.Add

ActiveWorkbook.SaveAs WBName

ActiveWindow.ActivateNext 'Geht wieder zurück zum Einlesewerkzeug

WSZiel.Activate

Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

ActiveWindow.ActivateNext

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _

, SkipBlanks:=False, Transpose:=False

Range("A1").Select

Selection.End(xlToRight).Select

Selection.ColumnWidth = 13

Range("A1").Select

Application.CutCopyMode = False

ActiveSheet.Name = "Gesamt"

'Sheets("Tabelle1").Select

'Sheets("Tabelle1").Name = "Gesamt"

ActiveWorkbook.Save

ActiveWindow.Close

'Range("C15").Select

Windows("Ordner_lesen.xlsm").Activate

Botschaft = "Die neu eingelesenen Daten wurden in der Datei " & WBName & " abgespeichert."

Box = MsgBox(Botschaft, vbOKOnly, "Abschlussmeldung")

'Die neu hinzugefügten Hilfsblätter werden wieder gelöscht

Sheets(Array("Liste", "LEB_gesamt")).Select

Sheets("LEB_gesamt").Activate

ActiveWindow.SelectedSheets.Delete

Range("B13").Select

Call Abschluss

End Sub

‘*********************************************

Private Sub Abschluss()

'Abschluss: alles zurücksetzen auf Normalbetrieb

Set oFile = Nothing

Set oFolder = Nothing

Set oSheet = Nothing

Set oFSO = Nothing

With Application

.ScreenUpdating = True

.StatusBar = ""

.Calculation = xlCalculationAutomatic

.EnableEvents = True

.DisplayAlerts = True

.Cursor = xlDefault

End With

End Sub

‘*********************************************

Private Sub HilfsUeberschriften()

Dim i As Byte

oSheet.Cells(1, 1) = "Pfad"

oSheet.Cells(1, 2) = "Dateiname"

oSheet.Columns(1).ColumnWidth = 40

oSheet.Columns(2).ColumnWidth = 40

For i = 1 To 2

With oSheet

.Cells(1, i).Interior.ColorIndex = 11

.Cells(1, i).Font.Color = vbWhite

.Cells(1, i).Font.Bold = True

End With

Next i

End Sub

‘*********************************************

Private Sub Pfade_Lesen(ByVal sPath As String)

'Dim oFSO As Object

'Dim oFolder As Object

Dim oSubFolder As Object

'Dim oFile As Object

Dim i As Byte

Application.StatusBar = "Dateinamen einlesen"

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.getfolder(sPath)

With oSheet

'Alle Dateien auflisten

'For Each oFile In oSubFolder.Files

For Each oFile In oFolder.Files

.Cells(lRowCounter, 1) = oFolder.Path

.Cells(lRowCounter, 2) = oFile.Name

lRowCounter = lRowCounter + 1

Next oFile

End With

'Komplette Datei-Adressen ermitteln und in die 3. Spalte eintragen

Range("C2").Select

For i = 2 To lRowCounter - 1

Application.CutCopyMode = False

Selection.FormulaR1C1 = "=RC[-2]&""\""&RC[-1]"

Cells(i + 1, 3).Select

Next i

End Sub

‘*********************************************

Private Sub Daten_lesen_neu()

Dim WorkB As Workbook

Dim i As Byte 'Zählvariable

Const LiOEk = "B2" 'Adresse der linken oberen Ecke

Const Spalt As Byte = 19 'Anzahl der Spalten

Dim Zeilen As Integer 'Anzahl der Zeilen

Dim ZielZeile As Integer 'Zeile, wo in Zieltabelle kopiert wird

Dim ReUEk 'Adresse der rechten unteren Ecke

Application.StatusBar = "Daten einlesen und aneinanderhängen"

ZielZeile = 2 'Anfangswert setzen

For i = 2 To DatZahl + 1

Sheets("Liste").Activate

Cells(i, 3).Select

DatName = Selection.Value

Set WorkB = Workbooks.Open(DatName) 'Quell-Mappe öffnen

Worksheets("Gesamt").Activate

Set WSQuell = ActiveWorkbook.ActiveSheet

Range(LiOEk).Select

Selection.End(xlDown).Select

Zeilen = ActiveCell.Row

Cells(Zeilen, Spalt).Select

Range(Selection, "A2").Select

Selection.Copy

'Windows("Ordner_lesen.xlsm").Activate

'Workbooks.Open ("Dateien_laden.xlsm")

WBZiel.Activate

Worksheets("LEB_gesamt").Activate

Cells(ZielZeile, 1).Select

'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

'WSZiel.Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

'WSQuell.Range(Selection, "A2").Select

'Selection.Copy Destination:=WSZiel.Cells(ZielZeile, 1)

'WSZiel.Select

'Cells(ZielZeile, 1).Select

'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Cells(ZielZeile, 1).Select

WorkB.Activate

Application.CutCopyMode = False

Range("B2").Select

ActiveWindow.Close

'WorkB.Close 'Quell-Mappe schließen

WSZiel.Activate

'Range("A1").Select

Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Select

ZielZeile = Selection.Row

Next i

End Sub

‘*********************************************

Private Sub ZielUeberschriftenNeu()

Application.StatusBar = "Überschriften für die Großtabelle erstellen"

Range("A1").Select

Selection.Value = "Verband ID"