Concatenar filas si coinciden columnas

Prueba con la siguiente macro y me comentas

Cambia "Hoja1" por el nombre de la hoja donde tienes tus datos

Cambia "Hoja2" por el nombre de la hoja donde quieres los resultados

Sub Concatenar_Datos()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.Cells.Clear
    For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B").Find(h1.Cells(i, "B"), lookat:=xlPart)
        If Not b Is Nothing Then
            fila = b.Row
            h2.Cells(fila, "A") = h2.Cells(fila, "A") & ", " & h1.Cells(i, "A")
            h2.Cells(fila, "B") = h2.Cells(fila, "B") & ", " & h1.Cells(i, "B")
        Else
            fila = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
            h2.Cells(fila, "A") = h1.Cells(i, "A")
            h2.Cells(fila, "B") = h1.Cells(i, "B")
        End If
    Next
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Abajo de la pantalla resultados esta la macro

esta es la macro, solo cambia el a1 por la celda donde empiezan tus datos.

Sub concatenar()
Set datos = Range("a1").CurrentRegion
With datos
    pares = WorksheetFunction.Quotient(.Rows.Count, 2)
    restos = .Rows.Count Mod 2
    Set texto = .Columns(.Columns.Count + 2).Resize(pares + restos, 2)
    matriz = texto
    For i = 1 To pares
        If i = 1 Then Set par = .Resize(2)
       If i > 1 Then Set par = par.Rows(par.Rows.Count + 1).Resize(2)
        matriz(i, 1) = par.Cells(1, 1) & ", " & par.Cells(2, 1)
        matriz(i, 2) = par.Cells(1, 2) & ", " & par.Cells(2, 2)
    Next i
End With
If restos > 0 Then
    Set par = par.Rows(par.Rows.Count + 1).Resize(1)
    matriz(i, 1) = par.Cells(1, 1)
    matriz(i, 2) = par.Cells(1, 2)
End If
Range(texto.Address) = matriz
End Sub