Macro - Copy and Combine values in cell and paste it in other cells based on Unique ID

Give this a try

Option Explicit
Sub abc()
 Dim a, k, i As Long, ii As Long
 
 a = Range("a1").CurrentRegion
 
 With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 2 To UBound(a)
        If Not .exists(a(i, 1)) Then
            .Item(a(i, 1)) = a(i, 3)
        Else
            If Not InStr(.Item(a(i, 1)), a(i, 3)) > 0 Then
                .Item(a(i, 1)) = .Item(a(i, 1)) & "," & a(i, 3)
            End If
        End If
    Next
    k = .keys
    For i = 2 To UBound(a)
        For ii = 0 To UBound(k)
            If a(i, 1) = k(ii) Then
                a(i, 2) = .Item(a(i, 1))
                Exit For
            End If
        Next
    Next
    Range("a1").Resize(UBound(a), UBound(a, 2)) = a
 End With
End Sub