Thema: Neue Anordnung einer Tabelle in zweitem Tabellenblatt

StandardModule: basMain

Sub TabUmwandeln()
   Dim wks As Worksheet
   Dim var As Variant
   Dim iRowL As Integer, iRow As Integer, _
      iCol As Integer, iRowT As Integer
   Dim iColT As Integer
   Dim sLager As String
   iRowL = Cells(Rows.Count, 1).End(xlUp).Row
   Set wks = ActiveSheet
   Worksheets.Add after:=Worksheets(wks.Index)
   iRowT = 1
   For iRow = 1 To iRowL
      If IsEmpty(wks.Cells(iRow, 2)) Then
         If IsEmpty(Range("B1")) Then
            iCol = 2
         Else
            iCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
         End If
         Cells(1, iCol).Value = wks.Cells(iRow, 1).Value
         sLager = wks.Cells(iRow, 1).Value
      Else
         var = Application.Match(wks.Cells(iRow, 1).Value, Columns(1), 0)
         If IsError(var) Then
            iRowT = iRowT + 1
            Cells(iRowT, 1).Value = wks.Cells(iRow, 1).Value
            Cells(iRowT, 2).Value = wks.Cells(iRow, 2).Value
         Else
            iColT = WorksheetFunction.Match(sLager, Rows(1), 0)
            Cells(var, iColT).Value = _
               Cells(iRowT, iColT).Value + wks.Cells(iRow, 2).Value
         End If
      End If
   Next iRow
   Cells(1, iCol + 1).Value = "Gesamt"
   iRow = 2
   Do Until IsEmpty(Cells(iRow, 1))
      Cells(iRow, iCol + 1).Value = _
         WorksheetFunction.Sum(Range(Cells(iRow, 2), Cells(iRow, iCol)))
      iRow = iRow + 1
   Loop
   Rows(1).Font.Bold = True
   Rows(1).HorizontalAlignment = xlRight
End Sub

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