Move data from rows into columns for every unique value

Hi,
I have a 2 Table
No. (1) contains a repetition of names and numbers
The second table is the result of the first table

put name in column A and num in column B, then run this macro

Code:

---

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
r = 4
c = 2
Do While Cells(r, 1) <> ""
  If Cells(r, 1) = Cells(r - 1, 1) Then
    c = c + 1
    Cells(r - 1, c) = Cells(r, 2)
    Rows(r).Delete
  Else
    c = 2
    r = r + 1
  End If
Loop
End Sub

---

THANK YOU
I hope that by the formula

Hi

All are ARRAY formulas.

In A21:

=SUM(IF(FREQUENCY(MATCH(B3:B19,B3:B19,0),ROW(B3:B1 9)-ROW(B3)+1),1))

A23 and copied down:

=IF(ROWS($A$23:A23)<=$A$21,INDEX($B$3:$B$19,MATCH( 0,COUNTIF($A$22:A22,$B$3:$B$19),0)),"")

B23 and copied across:

=IF(COLUMNS($B23:B23)<=COUNTIF($B$3:$B$19,$A23),IN DEX($A$3:$A$19,SMALL(IF($B$3:$B$19=$A23,ROW($B$3:$ B$19)-ROW($B$3)+1),COLUMNS($B23:B23))),"")

Please find attached.

Thank you. Now I will study your solution and learn.

Thank you.