Thema: Sammeln von Monatsblatt-Werten in einer Zusammenfassung

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   With Application.CommandBars("Worksheet Menu Bar")
      On Error Resume Next
      .Controls("&Monate").Delete
      On Error GoTo 0
   End With
End Sub

Private Sub Workbook_Open()
   Dim objPopUp As CommandBarPopup
   Dim objBtn As CommandBarButton
   With Application.CommandBars("Worksheet Menu Bar")
      On Error Resume Next
      .Controls("&Monate").Delete
      On Error GoTo 0
      Set objPopUp = .Controls.Add( _
         Type:=msoControlPopup, _
         before:=.Controls.Count, _
         temporary:=True)
   End With
   objPopUp.Caption = "&Monate"
   Set objBtn = objPopUp.Controls.Add
   With objBtn
      .Caption = "&In Sammelblatt"
      .OnAction = "InSammelblatt"
      .Style = msoButtonCaption
   End With
   Set objBtn = objPopUp.Controls.Add
   With objBtn
      .Caption = "&Beenden"
      .OnAction = "EndeMonate"
      .Style = msoButtonCaption
   End With
End Sub

StandardModule: Modul1

Sub MonatAnlegen()
   Dim iMonth As Integer
   For iMonth = 1 To 12
      Worksheets.Add after:=Worksheets(iMonth)
      ActiveSheet.Name = Format(DateSerial(1, iMonth, 1), "mmmm")
   Next iMonth
   Worksheets(1).Select
End Sub

Sub EndeMonate()
   ThisWorkbook.Close
End Sub

Sub InSammelblatt()
   Dim rng As Range
   Dim iCol As Integer
   If ActiveSheet.Index > 12 Then
      Beep
      MsgBox "Sie müssen sich in einem Monatsblatt befinden!"
      Exit Sub
   End If
   Set rng = Range("A2:A" & WorksheetFunction.CountA(Columns(1)))
   With Worksheets(13)
      iCol = WorksheetFunction.Match(ActiveSheet.Name, .Rows(1), 0)
      .Range(.Cells(2, iCol), .Cells(Rows.Count, iCol)).ClearContents
      .Range(.Cells(2, iCol), .Cells(rng.Rows.Count + 1, iCol)).Value = rng.Value
   End With
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Liste