Sub MergeCodes()
    Dim i As Long, lr As Long
    Dim rng As Range, cel As Range
    Dim str As String
    
With Sheets("Sheet1")    '<~~ change to actual sheet name
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    Set rng = .Range("A2:A" & lr)
End With
    
    For Each cel In rng
        If Len(cel.Value) = 10 Then
            For i = 1 To lr
                If Len(cel.Offset(i).Value) < 10 And cel.Offset(i).Value <> "" Then
                    str = str & ", " & cel.Offset(i).Value
                Else
                    cel.Offset(, 1).Value = Mid(str, 3)
                    str = ""
                    Exit For
                End If
            Next i
        End If
    Next cel
    
End Sub