mein Anliegen wurde dank der Hilfe von "ChrisL" gelöst, jedoch läuft sein Makro nur bei Excel 2013 fehlerfrei. Sobald ich sein Makro in Excel 2007 ausführe, kommt leider eine Fehlermeldung.
Hier meine Beispielsmappe:
https://www.herber.de/bbs/user/111013.xlsx
Hier der Code von ChrisL:
Sub tt()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iZähler As Long
Dim LetzteZeile As Long, merkeZeile As Long
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
Application.ScreenUpdating = False
WS2.Rows("2:65536").Delete
With WS1
LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
With .Sort
.SortFields.Clear
.SortFields.Add Key:=WS1.Range("B2:B" & LetzteZeile), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=WS1.Range("A2:A" & LetzteZeile), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange WS1.Range("A1:C" & LetzteZeile)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For iZeile = 2 To LetzteZeile
If .Cells(iZeile, 2) .Cells(iZeile - 1, 2) Then
'neuer Block
If merkeZeile 0 Then WS2.Cells(merkeZeile, 3).Formula = _
"=SUM(C" & merkeZeile + 1 & ":C" & iZähler & ")"
iZähler = iZähler + 2
merkeZeile = iZähler
WS2.Cells(iZähler, 1) = .Cells(iZeile, 2)
With WS2.Range(WS2.Cells(iZähler, 1), WS2.Cells(iZähler, 3)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
If WS2.Cells(iZähler, 2) = .Cells(iZeile, 1) Then
' verdichten wenn Land vorhanden
WS2.Cells(iZähler, 3) = WS2.Cells(iZähler, 3) + .Cells(iZeile, 3)
Else
' neuer Datensatz in bestehendem Block
iZähler = iZähler + 1
WS2.Cells(iZähler, 2) = .Cells(iZeile, 1)
WS2.Cells(iZähler, 3) = .Cells(iZeile, 3)
End If
Next iZeile
WS2.Cells(merkeZeile, 3).Formula = "=SUM(C" & merkeZeile + 1 & ":C" & iZähler & ")" hier _
Laufzeitfehler 1004, es wird keine Summe in Spalte C gebildet
End With
End Sub
Danke euch!