Gegeben ist eine Arbeitsmappe mit mehreren Tabel­len­blät­tern. Als Beispiel ver­wende ich die in meinen Schu­lun­gen lieb gewonnene Bäck­erei Klein­brot. In dieser Mappe sind 12 Arbeits­blät­ter (Reg­is­ter), welche jew­eils den entsprechen­den Monat­sna­men haben. Weit­er­hin ist ein Blatt enthal­ten, wo die Feiertage des entsprechen­den Jahres aufge­lis­tet sind. Die Monats-Blät­ter sind alle iden­tisch aufge­baut, die Anzahl der Zeilen ist dem entsprechen­den Monat angepasst.

Diese 12 Blät­ter sollen nun in der aktuellen Mappe in einem neuen Blatt zusam­menge­fasst wer­den. Es soll nicht kon­so­li­diert (alle Zahlen addiert) wer­den, da die einzel­nen Werte nach wie vor im Zugriff für Auswer­tun­gen in ein­er Piv­ot­Table vorhan­den sein sollen. Das Reg­is­ter Feiertage soll naturgemäß nicht in die Zusam­men­fas­sung inte­gri­ert wer­den, diese Dat­en haben in dieser Auf­gabe keine Bedeu­tung.

Natür­lich lassen sich die weni­gen Blät­ter von Hand untere­inan­der kopieren. Aber weniger schön wird es dann, wenn beispiel­sweise erst die Dat­en des ersten hal­ben Jahres eingegeben wor­den sind und Monat für Monat die gle­iche Proze­dur des Kopierens erfol­gen muss. Und noch unan­genehmer ist es gewiss dann, wenn in einem früheren Monat eine Änderung gebucht wor­den ist. Das kann dur­chaus ein­mal eine Zeile weniger oder mehr sein (zugegeben, nicht in solch ein­er Monat­sauf­stel­lung) oder eine Änderung des Betrages. Dann ist „Fum­me­lar­beit” ange­sagt. Darum sollte so etwas von einem Makro erledigt wer­den.

Prinzip­iell läuft das Makro so ab:

• Ein neues Blatt mit dem Namen Zusam­men­fas­sung anle­gen.
• Die erste Zeile Datum bis Son­stiges kopieren …
• … und in A1:G1 der Zusam­men­fas­sung als Wert mit Zahlen­for­mat ein­fü­gen (damit eventuelle andere For­matierun­gen nicht mit über­nom­men wer­den).
• Begin­nend mit Jan­u­ar und endend mit Dezem­ber jew­eils A2:Gnn kopieren und an das Ende der vorhan­de­nen Dat­en im Blatt Zusam­men­fas­sung gle­icher­maßen anfü­gen. Das nn in der Kopi­er-Adresse bezieht sich auf die Zeile mit dem Monat­slet­zten, der ja von Monat zu Monat unter­schiedlich ist.

Vielle­icht fra­gen Sie sich jet­zt, warum die jew­eili­gen Sum­men-Felder nicht mit kopiert wer­den. Das hängt mit dem Prinzip zusam­men, dass so wenig wie möglich Redun­danzen (mehrfach vork­om­mende Werte) geschaf­fen wer­den soll­ten. Die Zusam­men­fas­sung wird die Grund­lage für eine Piv­ot­Table sein, und dort kann dann nach Herzenslust ohne den Bal­last vorge­fer­tigter Ergeb­nisse aus­gew­ertet wer­den.

Die erste Ver­sion des Codes ist weit­ge­hend uni­versell gehal­ten, damit eine Anpas­sung für andere Daten­struk­turen leichter möglich ist. Eine kleine Änderung wird wegen der „Intel­li­genz” des Excel in Sachen Rei­hen­folge der Monate noch fol­gen. Hier nun erst ein­mal der Basis-Code:

Option Explicit

Sub BlaetterZusammenfassen()
   Dim wks As WorkSheet, wksZiel As WorkSheet, Blatt As Long, AnzBlaetter As Long
   Dim Ziel As String, lRowS As Long, lRowD As Long
   
   Application.ScreenUpdating = False
   Ziel = "Zusammenfassung"
   If Not BlattExistiert(Ziel) Then
   AnzBlaetter = Sheets.Count
      Sheets.Add After:=Sheets(AnzBlaetter)
      ActiveSheet.Name = Ziel
   End If
   Set wksZiel = Sheets(Ziel)
   Sheets("Januar").Range("A1:G1").Copy
   wksZiel.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats   'Falls Zahlen in der Überschrift sind
   AnzBlaetter = Sheets.Count
   For Blatt = 1 To AnzBlaetter
      If Sheets(Blatt).Name <> Ziel And Sheets(Blatt).Name <> "Feiertage" Then
         lRowS = lRow(Sheets(Blatt))
         lRowD = lRow(wksZiel)
         Sheets(Blatt).Range("A2:G" & lRowS - 1).Copy
         wksZiel.Range("A" & lRowD + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      End If
   Next Blatt
   Application.CutCopyMode = False
   wksZiel.Columns(1).AutoFit
   Range("A1").Select   'Ausnahsweise :-)
End Sub

'Wks auf Existenz prüfen
Function BlattExistiert(BlattName) As Boolean
   Dim x As Variant, EN As Variant
   On Error GoTo ErrorHandler
   x = Sheets(BlattName).Cells(1, 1)
   BlattExistiert = True
   Exit Function

ErrorHandler:
   BlattExistiert = False
End Function

Function lRow(wks As WorkSheet) As Long
   lRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
End Function

Dieser Code läuft ein­wand­frei und kann auch von Ein­steigern mit grundle­gen­den Vorken­nt­nis­sen in Sachen VBA auf eine andere Daten­struk­tur angepasst wer­den.

▲ nach oben …

Speziell für diese Auf­gabe, wo alle Monate eines Jahres aus­gew­ertet wer­den sollen, bietet sich fol­gende Änderung des Codes an:

Sub BlaetterZusammenfassen2()
   Dim wks As WorkSheet, wksZiel As WorkSheet, AnzBlaetter As Long
   Dim Ziel As String, lRowS As Long, lRowD As Long
   Dim aMonat(12), Monat As String, i As Long
   
   Application.ScreenUpdating = False
   Ziel = "Zusammenfassung"
   If Not BlattExistiert(Ziel) Then
   AnzBlaetter = Sheets.Count
      Sheets.Add After:=Sheets(AnzBlaetter)
      ActiveSheet.Name = Ziel
   End If
   Set wksZiel = Sheets(Ziel)
   For i = 1 To 12
      aMonat(i) = Format(DateSerial(2000, i, 1), "MMMM")
   Next i
   
   Sheets(aMonat(1)).Range("A1:G1").Copy
   wksZiel.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats   'Falls Zahlen in der Überschrift sind
   For i = 1 To 12
      Set wks = Sheets(aMonat(i))
      lRowS = lRow(wks)
      lRowD = lRow(wksZiel)
      wks.Range("A2:G" & lRowS - 1).Copy
      wksZiel.Range("A" & lRowD + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
   Next i
   Application.CutCopyMode = False
   wksZiel.Columns(1).AutoFit
   Range("A1").Select   'Ausnahsweise :-)
End Sub

Die erste Änderung ist im Kopf­bere­ich zu sehen. Unter­halb Option Explic­it ist die Zeile

Option Base 1

einge­fügt. Das bewirkt, dass alle Arrays 1‑basiert sind, immer mit Ele­ment (Index) 1 begin­nen und nicht mit 0. Auch wenn manche „Infor­matik­er” das süff­isant als „Fraue­neschal­ter” beze­ich­nen, hat das seine Vorteile. Ich muss nicht ewig umdenken, denn manche Arrays in Excel-VBA fan­gen von Haus aus mit 1 an.

Die restlichen Änderun­gen erken­nen Sie sel­ber, wenn Sie die weni­gen Zeilen ver­gle­ichen. Neue Vari­ablen sind hinzugekom­men, andere wur­den gelöscht. Die eigentliche Neuerung ist, dass ein Array mit den Monat­sna­men (übri­gens lan­destyp­isch und in den Lan­de­se­in­stel­lun­gen des Sys­tems) erstellt und dann nacheinan­der direkt auf das jew­eilige Blatt zuge­grif­f­en wurde.

▲ nach oben …

Was noch prinzip­iell verbessert bzw. verän­dert wer­den kön­nte, basierend auf dem ersten Code:

1. Wenn bei Aufruf des Makros das Blatt Zusam­men­fas­sung existiert, dann soll dieses entwed­er kom­plett gelöscht oder nur der Inhalt geleert wer­den.
2. Tage ohne Umsatz sollen nicht über­nom­men bzw. eli­m­iniert wer­den.
3. Nur wenige benan­nte von vie­len Tabel­len­blät­tern sollen kopiert wer­den.

Zum ersten Punkt: Das ist gewiss immer dann wichtig, wenn diese Sub monatlich aufgerufen wird. Da hier zu Beginn immer alle Monate an die vorhan­de­nen Dat­en ange­fügt wer­den, gibt das einen Dat­en-Wirrwarr, der so nicht kor­rekt aus­gew­ertet wer­den kann. Hier ein geän­dert­er Code-Auss­chnitt, um die Dat­en zu löschen:

If Not BlattExistiert(Ziel) Then
   AnzBlaetter = Sheets.Count
   Sheets.Add After:=Sheets(AnzBlaetter)
   ActiveSheet.Name = Ziel
Else
   Sheets(Ziel).Cells.ClearContents
End If

Das Blatt vorher zu löschen ist prinzip­iell nicht erforder­lich. Falls Sie den­noch Wert darauf leg­en, zeich­nen Sie den Code ein­fach auf, passen die Blat­tEx­istiert-Prü­fung an und inte­gri­eren ihn an passender Stelle.

Den zweit­en Punkt kön­nen Sie am ein­fach­sten lösen, indem Sie einen kleinen Umweg gehen …

• Kopieren Sie erst alle Dat­en, wie gehabt.
• Machen Sie aus den Dat­en in Zusam­men­fas­sung eine Liste, eine Intel­li­gente Tabelle; beispiel­sweise mit StrgT oder StrgL.
• Tra­gen Sie in H1 eine Über­schrift ein, beispiel­sweise Umsatz.
• Fügen Sie in H2 diese Formel ein: =SUMME(B2:G2)>0. Wenn Sie auf die Felder B2 und G2 Klick­en, dann wer­den die Feld­na­men der Liste automa­tisch über­nom­men; das ist auch OK. Alle Zeilen enthal­ten nun einen WAHR/FALSCH-Wert.
• Fil­tern Sie Spalte H nun nach FALSCH und löschen die entsprechen­den angezeigten Zeilen (natür­lich nicht die Über­schrift).
• Anschließend kön­nen Sie die „Hil­f­ss­palte” wieder löschen.

Der dritte Punkt bedeutet wiederum eine andere Pro­gram­mierung. Die Basis­dat­en sind die gle­ichen, der Ein­fach­heit hal­ber aber sollen nur die ersten drei Monate kopiert wer­den. Und es wird davon aus­ge­gan­gen, dass die Arbeits­blät­ter / Reg­is­ter auch tat­säch­lich in der aktuellen Mappe existieren (das erspart eine immer wiederkehrende Über­prü­fung).

Sub BlaetterZusammenfassen3()
   Dim wks As WorkSheet, wksZiel As WorkSheet, Blatt As Long, AnzBlaetter As Long
   Dim Ziel As String, lRowS As Long, lRowD As Long
   
   Application.ScreenUpdating = False
   Ziel = "Zusammenfassung"
   If Not BlattExistiert(Ziel) Then
      AnzBlaetter = Sheets.Count
      Sheets.Add After:=Sheets(AnzBlaetter)
      ActiveSheet.Name = Ziel
   Else
      Sheets(Ziel).Cells.ClearContents
   End If
   Set wksZiel = Sheets(Ziel)
   
   For Each wks In ThisWorkbook.Sheets
      Select Case wks.Name
      Case "Januar", "februar", "März"
         lRowS = lRow(wks)
         lRowD = lRow(wksZiel)
         wks.Range("A2:G" & lRowS - 1).Copy
         wksZiel.Range("A" & lRowD + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      End Select
   Next wks
   Application.CutCopyMode = False
   wksZiel.Columns(1).AutoFit
   Range("A1").Select   'Ausnahsweise :-)
End Sub

Und ja, es ist ein Fehler im Code. Denn Sie wer­den beim Aus­führen rasch fest­stellen, dass nur zwei Monate kopiert wor­den sind. Und das hat nichts damit zu tun, dass es bei­des Monate mit 31 Tagen sind oder der Feb­ru­ar die Son­der­stel­lung mit den ²⁸⁄₂₉ Tagen hat. Die Ursache ist ein­fach gemein 😉 . Im Code ist der Monat­sname klein geschrieben und im Reg­is­ter ist das erste Zeichen natür­lich groß. Aber VBA nimmt es mit der Groß- Klein­schrei­bung wesentlich genauer als Excel selb­st. Ändern Sie den „feb­ru­ar” auf „Feb­ru­ar” und alles wird seinen kor­rek­ten Weg gehen. – Natür­lich lässt sich eine der­ar­tige Selek­tion auch mit beliebi­gen anderen Blat­tna­men bew­erk­stel­li­gen.

In neueren Excel-Ver­sio­nen (Win­dows), ab Excel 2010, lässt sich solch ein Prob­lem auch sehr ele­gant mit einem Add-In Pow­er Query lösen. In der 2016^er-Ver­sion (auch nur Win­dows) ist dieses Werkzeug schon inte­gri­ert.

▲ nach oben …

Rück­mel­dun­gen / Feed­back gerne per Mail an mich (G.Mumme@Excel-ist-sexy.de)

Hat Ihnen der Beitrag gefallen?
Erleichtert dieser Beitrag Ihre Arbeit?

Dann würde ich mich über einen Beitrag Ihrer­seits z.B. 2,00 € freuen … (← Klick mich!)