Sub gozyva()
Dim conc()
Dim c As Range
Dim dec&
Set c = Range("A10"): Set d = Range("G9")
Do While c <> ""
ReDim Preserve conc(c.Row)
conc(c.Row) = c & c(1, 2) & c(1, 3) & c(1, 4)
If conc(c.Row) <> conc(c.Row - 1) Then
dec = 0
Set d = d(2, 1)
c.Resize(, 4).Copy Destination:=d
d(1, 5) = "/"
d(1, 6) = c(1, 5)
Else
d(1, 7 + dec) = c(1, 5)
dec = dec + 1
End If
Set c = c(2, 1)
Loop
End Sub