行列関係のエクセルＶＢＡ作成をお願いします。

以下のマクロでご希望の操作ができると思います。
お客様名、商品名の位置を変更したい場合、START_NAME、START_SHOHINの内容を変更してください。

Sub ReSummary()
    Const START_NAME = "G11"
    Const START_SHOHIN = "AE11"

    Set nameDic = CreateObject("Scripting.Dictionary")
    
    ' 情報収集
    Set nameRange = Range(START_NAME)
    rowOffset = 0
    Do While Not nameRange.Value = ""
        Set shohinRange = Range(START_SHOHIN).Offset(rowOffset, 0)
        If nameDic.exists(nameRange.Value) = False Then
            Call nameDic.Add(nameRange.Value, shohinRange.Value)
        Else
            nameDic(nameRange.Value) = nameDic(nameRange.Value) & "、" & shohinRange.Value
        End If
    
        Set nameRange = nameRange.Offset(1, 0)
        rowOffset = rowOffset + 1
    Loop
    
    ' 書き換え
    Set nameRange = Range(START_NAME)
    rowOffset = 0
    Do While Not nameRange.Value = ""
        Set shohinRange = Range(START_SHOHIN).Offset(rowOffset, 0)
        If nameDic.exists(nameRange.Value) Then
            shohinRange.Value = nameDic(nameRange.Value)
            Call nameDic.Remove(nameRange.Value)
        Else
            shohinRange.Value = ""
        End If

        Set nameRange = nameRange.Offset(1, 0)
        rowOffset = rowOffset + 1
    Loop
    
    MsgBox "end"
    
End Sub