Dim wks As Excel.Worksheet
Dim wksD As Excel.Worksheet
Dim rng As Excel.Range
Dim rngD As Excel.Range
Dim tmp As String
Set wks = Tabelle1
Set wksD = Tabelle2
Set rng = wks.Range("A1:D1,F1")
Set rngD = wksD.Range("A1")
tmp = rng.Cells(, 5).Text
Do Until rng.Offset(1).Cells(, 1).Text = ""
If IsEqual(rng.Offset(1), rng) Then
tmp = tmp & IIf(tmp <> "", ", ", "") & rng.Offset(1).Cells(, 5).Text
ElseIf tmp <> "" Then
rng.Copy rngD
rngD.Cells(, 4).Value = tmp
Set rngD = rngD.Offset(1)
tmp = ""
End If
Set rng = rng.Offset(1)
Loop
If tmp <> "" Then
rng.Copy rngD
rngD.Cells(, 4).Value = tmp
Set rngD = rngD.Offset(1)
End If
End Sub