Option Explicit

Sub X()
Dim Lrow As Long, X As Long, LastId, LastRow As Long, ObjectID As String
    With ThisWorkbook.Sheets("Tabelle1")
        Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = 3
        LastId = .Range("A3") & .Range("B3") & .Range("C3") & .Range("D3")
        X = 0
        
        For X = 3 To Lrow - 1
            If X = Lrow + 1 Then Exit For
            If LastId = .Range("A" & Lrow) & .Range("B" & Lrow) & .Range("C" & Lrow) & .Range("D" & Lrow) Then
                .Range("G" & LastRow) = .Range("G" & X - 1) & ", " & .Range("G" & Lrow)
                .Range("E" & LastRow) = .Range("E" & Lrow) + .Range("E" & X - 1)
                .Rows(Lrow).Delete shift:=xlUp
                Lrow = Lrow - 1
                X = X - 1
                Else
                LastRow = X
                Rem  LastRow = LastRow + 1
                LastId = .Range("A" & X) & .Range("B" & X) & .Range("C" & X) & .Range("D" & X)
            End If
        Next
    
    End With
End Sub