試試看吧!
https://c-t.work/s/e10b0cf1e92b4f

應該可以滿足你的需求

註解有點難表達

Option Explicit

Sub member()

    Dim i As Integer
    Dim leader_row As Integer
    Dim member_col As Integer

    i = 2
    Do Until Range("A" & i) = ""
        
        '組長位置(如有重複會找第一個位置)
        leader_row = Columns("A").Find(Range("A" & i)).Row
        
        '組長旁邊組員的空格欄
        member_col = Rows(leader_row).Find("").Column
        
        '如果不是第一個組長位置 則把成員寫到第一個組長位置旁邊的空格
        '填上後刪除i欄 不往下找(i不加1) 因為已經刪除i欄 下欄會往上遞補 所以繼續查找i欄
        If i <> leader_row Then
            Cells(leader_row, member_col) = Range("B" & i)
            Rows(i).Delete
        '往下繼續查找
        Else
            i = i + 1
        End If
        
    Loop
    
End Sub

試試(結果放DE欄)
Sub 巨集1()
rA = Range("A1").End(xlDown).Row
Range("A1:A" & rA).Copy Range("D1")
ActiveSheet.Range("D1:D" & rA).RemoveDuplicates Columns:=1, Header:=xlNo
rD = Range("D1").End(xlDown).Row
c = 5
For i = 1 To rD
For j = 1 To rA
If Cells(i, "D") = Cells(j, "A") And Cells(j, "B") <> "" Then
Cells(i, c) = Cells(j, "B")
c = c + 1
End If
Next j
c = 5
Next i
End Sub