buscarv múltiples resultados

Hola! Me acaban de dar la respuesta y funciona, la dejo aquí por si le sirve de ayuda a alguien ;). Sl2!

Sub reordenarFases()
'x Elsamatilde
Set ho1 = Sheets("Hoja1")
'controla que haya datos
x = ho1.Range("A" & Rows.Count).End(xlUp).Row
If x < 2 Then MsgBox "No hay datos en Hoja1": Exit Sub
'ordenar la hoja    .... opcional: en otro rango o volver a reordenarla al finalizar
If x > 2 Then
    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A2:A" & x), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Hoja1").Sort
        .SetRange Range("A1:B9" & x)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End If
'limpiar tabla destino de posibles datos anteriores
Set ho2 = Sheets("Hoja2")
ho2.[A2].CurrentRegion.Offset(1, 0).ClearContents
y = 1    'fila de destino
'recorrer la Hoja1 y crear registro hasta cambiar de código
For i = 2 To x
    'si cambia de código se pasa a fila sgte en destino
    If ho1.Range("A" & i) <> codi Then
        codi = ho1.Range("A" & i)
        y = y + 1
        ho2.Range("A" & y) = codi
    End If
    Set busco = ho2.Rows("1:1").Find("Fase" & ho1.Range("B" & i), LookIn:=xlValues, lookat:=xlWhole)
    If Not busco Is Nothing Then
        ho2.Cells(y, busco.Column) = ho1.Range("B" & i)
    End If
Next i
MsgBox "Fin del proceso"
End Sub