Dieses hier gezeigte Tabel­len­blatt (Tabelle1) soll als Grund­lage für eine Piv­ot­Ta­belle herg­erichtet wer­den. Dazu müssen für die Monate Jan­u­ar bis Dezem­ber je ein neues Arbeits­blatt angelegt und die monatlichen Dat­en ohne Zusam­men­fas­sung und auch ohne Auswer­tung über­tra­gen wer­den. Damit wird der Grund­satz erfüllt, dass zusam­menge­hörige Dat­en auch zusam­men gehören, also in 1 Liste und nicht in ver­schiedene Blät­ter.

Der Über­sicht hal­ber und des für Ein­steiger besseren Lern­ef­fek­ts wegen vol­lziehe ich einen Schritt nach dem näch­sten, auch wenn ich das Ganze „In einem Rutsch” durchziehen kön­nte. Der Zeitver­lust durch das Aufteilen der Schritte in mehrere Makros liegt schätzungsweise unter ein­er zehn­tel Sekunde, und das sollte es Wert sein.

Schritt 1: 12 neue Arbeitsblätter anlegen

Dabei wer­den die Blät­ter nicht nur erstellt son­dern auch gle­ich mit den lan­de­seige­nen Monat­sna­men verse­hen. In Deutsch­land begin­nt das dann mit dem Jan­u­ar, in Öster­re­ich mit dem Jän­ner und in UAS mit dem Jan­u­ary:

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 Proze­dur leg­en Sie in dem Mod­ul DieseAr­beitsmappe ab. Damit ist der erste Schritt erledigt.

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

Als erstes wer­den Sie fes­tle­gen, dass Ihre Arrays nicht mit dem Index 0 begin­nen son­dern mit 1. Dazu schreiben Sie direkt unter OPtion Explic­it die Zeile Option Base 1.

Hier in diesem Beispiel wis­sen Sie ja, dass Jan­u­ar das 2. Blatt ist. Es kann aber auch das 5. oder 23. Blatt sein. Darum wird erst ein­mal fest­gestellt, welchen Index das Work­Sheet Jan­u­ar hat. Und da dieser Wert später wieder in anderen Proze­duren gebraucht wird, kommt er in eine glob­ale Vari­able. Dazu tra­gen Sie direkt unter Option Base 1 in ein­er neuen Zeile ein:

Dim Jan_Index as Inte­ger

Anschließend wer­den die Pro­duk­te untere­inan­der (statt nebeneinan­der) in die Monats­blät­ter einge­tra­gen. Und bei der Gele­gen­heit kommt in A1 jeden Monats die Über­schrift Pro­dukt 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 gle­ichen Prinzip wer­den nun auch die Umsätze der einzel­nen Monate über­tra­gen. Vielle­icht monieren Sie jet­zt, dass das Pro­gramm ja dann wieder bei Jan­u­ar anfängt und sich bis Dezem­ber dur­char­beit­et. Das ist richtig. Und in der endgülti­gen Ver­sion ist das auch so einge­baut, dass Pro­dukt und Umsatz in einem Rutsch über­tra­gen wer­den. Hier ste­ht der Effekt des Train­ings im Vorder­grund.

▲ 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!)