Gruppe
Allgemein
Problem
Die in den Monatsblättern gelisteten Werte sind in diesem Blatt nach Produkten addiert aufzulisten.
StandardModule: Modul1
Sub GetValues()
Dim vProduct As Variant
Dim iMonth As Integer, iRow As Integer, iWks As Integer, iRowT As Integer
Dim iCol As Integer
Rows(1).Font.Bold = True
Columns(1).Font.Bold = True
Range("A1").Value = "Products"
For iMonth = 1 To 12
Cells(1, iMonth + 1).Value = Format(DateSerial(1, iMonth, 2), "mmmm")
Next iMonth
For iWks = 3 To Worksheets.Count
For iCol = 1 To 12
vProduct = Application.Match( _
Worksheets(iWks).Cells(1, iCol).Value, Columns(1), 0)
If IsError(vProduct) Then
iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(iRow, 1).Value = Worksheets(iWks).Cells(1, iCol).Value
Cells(iRow, iWks - 1).Value = Worksheets(iWks).Cells(16, iCol).Value
Else
Cells(vProduct, iWks - 1).Value = Cells(vProduct, iWks - 1).Value + _
Worksheets(iWks - 1).Cells(16, iCol).Value
End If
Next iCol
Next iWks
Columns.AutoFit
End Sub