Dieses hier gezeigte Tabellenblatt (Tabelle1) soll als Grundlage für eine PivotTabelle hergerichtet werden. Dazu müssen für die Monate Januar bis Dezember je ein neues Arbeitsblatt angelegt und die monatlichen Daten ohne Zusammenfassung und auch ohne Auswertung übertragen werden. Damit wird der Grundsatz erfüllt, dass zusammengehörige Daten auch zusammen gehören, also in 1 Liste und nicht in verschiedene Blätter.

Der Übersicht halber und des für Einsteiger besseren Lerneffekts wegen vollziehe ich einen Schritt nach dem nächsten, auch wenn ich das Ganze “In einem Rutsch” durchziehen könnte. Der Zeitverlust durch das Aufteilen der Schritte in mehrere Makros liegt schätzungsweise unter einer zehntel Sekunde, und das sollte es Wert sein.

Schritt 1: 12 neue Arbeitsblätter anlegen

Dabei werden die Blätter nicht nur erstellt sondern auch gleich mit den landeseigenen Monatsnamen versehen. In Deutschland beginnt das dann mit dem Januar, in Österreich mit dem Jänner und in UAS mit dem January:

Sub MonateAnlegen()
   Dim Monat As Integer
   Dim aMonate(12)
   Dim Wks As WorkSheet
   
   For Monat = 1 To 12
      aMonate(Monat) = Format(CDate("1." & Monat), "MMMM")
   Next Monat
   
   For Each Wks In ActiveWorkbook.Sheets
      For Monat = 1 To 12
         If Wks.Name = aMonate(Monat) Then
            MsgBox "Das Blatt mit dem Namen " & aMonate(Monat) _
             & " exisiert bereits!" & vbCrLf _
             & "Das Makro wird aus diesem Grund beendet.", vbInformation, _
             "Information"
            Exit Sub
         End If
      Next Monat
   Next Wks
   
   For Monat = 1 To 12
      Sheets.Add After:=Worksheets(Sheets.Count)
      ActiveSheet.Name = aMonate(Monat)
   Next Monat
End Sub

Diese Prozedur legen Sie in dem Modul DieseArbeitsmappe ab. Damit ist der erste Schritt erledigt.

Schritt 2: Die Produkte in die Blätter einfügen

Als erstes werden Sie festlegen, dass Ihre Arrays nicht mit dem Index 0 beginnen sondern mit 1. Dazu schreiben Sie direkt unter OPtion Explicit die Zeile Option Base 1.

Hier in diesem Beispiel wissen Sie ja, dass Januar das 2. Blatt ist. Es kann aber auch das 5. oder 23. Blatt sein. Darum wird erst einmal festgestellt, welchen Index das WorkSheet Januar hat. Und da dieser Wert später wieder in anderen Prozeduren gebraucht wird, kommt er in eine globale Variable. Dazu tragen Sie direkt unter Option Base 1 in einer neuen Zeile ein:

Dim Jan_Index as Integer

Anschließend werden die Produkte untereinander (statt nebeneinander) in die Monatsblätter eingetragen. Und bei der Gelegenheit kommt in A1 jeden Monats die Überschrift Produkt und in B1 Umsatz.

Sub TransferProductNames()
   Dim Wks As Integer
   Dim aProdukte(), Sp As Integer, i As Integer
   Dim AnzProdukte As Integer
   
   'Prüfung, ob Grunddaten + 12 Monate vorhanden sind
   If Sheets.Count < 13 Then
      MsgBox "Es müssen mindestens 13 Datenblätter vorhanden sein!", vbCritical
      Exit Sub
   End If
   
   Jan_Index = 0
   For Wks = 1 To Worksheets.Count
      'Es führen viele Wege nach Rom ...
      If Sheets(Wks).Name = Format(DateSerial(2000, 1, 1), "MMMM") Then
         Jan_Index = Wks
         Exit For
      End If
   Next Wks
   
   'Und es muss das Januar-Blatt geben
   If Jan_Index = 0 Then
      MsgBox "Mindestens das Januar-Blatt fehlt!", vbCritical
      Exit Sub
   End If
   
   With Sheets("Tabelle1")
      ReDim aProdukte(.Range("B4:G4").Cells.Count)
      AnzProdukte = UBound(aProdukte)
      For Sp = 2 To AnzProdukte + 2 - 1
         aProdukte(Sp - 1) = .Cells(4, Sp)
      Next Sp
   End With
   For i = Jan_Index To Jan_Index + 11
      With Sheets(i)
         .Range("A1") = "Produkt"
         .Range("B1") = "Umsatz"
         .Range("A2:A" & 1 + AnzProdukte) = WorksheetFunction.Transpose(aProdukte)
      End With
   Next i
End Sub

Nach den gleichen Prinzip werden nun auch die Umsätze der einzelnen Monate übertragen. Vielleicht monieren Sie jetzt, dass das Programm ja dann wieder bei Januar anfängt und sich bis Dezember durcharbeitet. Das ist richtig. Und in der endgültigen Version ist das auch so eingebaut, dass Produkt und Umsatz in einem Rutsch übertragen werden. Hier steht der Effekt des Trainings im Vordergrund.

▲ nach oben …

Rückmeldungen / Feedback 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 Ihrerseits z.B. 2,00 € freuen … (← Klick mich!)