anbei ein VBA-Code, welcher Daten aus Tabelle1 in Tabelle3 blockweise kopiert,sortiert und anschließend die Summe in der 3.Spalte bildet.
Der ursprüngliche VBA-Code stammt von "ChrisL" (Mitglied im Forum und Danke nochmal an dieser Stelle :) ) und funktioniert einwandfrei, jedoch musste ich einige Änderungen vornehmen, da sich die Spalte meiner Ausgangstabelle (Tabelle1) und der Umfang verändert haben.
Der Code funktioniert bis zur Fehlerstelle einwandfrei:
Option Explicit
Sub tt()
Dim WS1 As Worksheet
Dim WS3 As Worksheet
Dim iZeile As Long
Dim iZähler As Long
Dim LetzteZeile As Long
Dim merkeZeile As Long
Set WS1 = Worksheets("Tabelle1")
Set WS3 = Worksheets("Tabelle3")
Application.ScreenUpdating = False
WS3.Rows("2:65536").Delete
With WS1
LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
With .Sort
.SortFields.Clear
.SortFields.Add Key:=WS1.Range("K2:K" & LetzteZeile), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal 'Modelle
.SortFields.Add Key:=WS1.Range("J2:J" & LetzteZeile), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal 'Länder
.SetRange Range("A1:AC" & LetzteZeile)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For iZeile = 2 To LetzteZeile
If .Cells(iZeile, 11) .Cells(iZeile - 1, 11) Then ' unterschiedlicher Modell Eintrag in _
_
WS1, dann neuer Modell - Block
If merkeZeile 0 Then WS3.Cells(merkeZeile, 3).Formula = _
"=SUM(C" & merkeZeile + 1 & ":C" & iZähler & ")"
iZähler = iZähler + 2 'Abstand zwischen den Blöcken
WS3.Cells(iZähler, 1) = .Cells(iZeile, 11) 'Eintrag in WS3 in 1.Spalte hier Modell Nummer
With WS3.Range(WS3.Cells(iZähler, 1), WS3.Cells(iZähler, 3)).Borders(xlEdgeBottom) 'Spalte _
_
1 bis 3 unterstreichen
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
If WS3.Cells(iZähler, 2) = Cells(iZeile, 10) Then 'verdichten, wenn Land vorhanden
WS3.Cells(iZähler, 3) = WS3.Cells(iZähler, 3) + .Cells(iZeile, 3)
Else
'neuer Datensatz in bestehenden Modell Block
iZähler = iZähler + 1
WS3.Cells(iZähler, 2) = .Cells(iZeile, 10)
WS3.Cells(iZähler, 3) = .Cells(iZeile, 28)
End If
Next iZeile
WS3.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
Vielen Dank euch!