Ａ列をキーとして同じ情報が入力されている行のデータを、
同じ情報を持つ一番上の行の右側に挿入（移動）して
1行のデータにまとめます。
　例えば以下のようなデータがあるとします。データは2列です。

    | A    B      C
  --+---------------------
  1 | 1F   高橋   鈴木
  2 | 1F   佐藤   杉山
  3 | 2F   ....   ....
  4 | 3F   ....   ....
  : |

　次のような結果を求めます。

    | A    B     C     D     E ...
  --+----------------------------------
  1 | 1F   高橋  佐藤  鈴木  杉山
  3 | 2F   ....   ....
  4 | 3F   ....   ....
  : |

　「高橋、鈴木、佐藤、杉山」ではなく、「高橋、佐藤、鈴木、杉山」
となることに注目してください。
　サンプルは、Ａ列のキーがソートされていることを前提条件
としています。

Sub Sample()

    Dim strKey As String        '検索キー
    Dim nRow   As Long          '行
    Dim nCol   As Long          '列

    '基準点をアクティブ
    Range("A1").Activate

    'アクティブセルが空になるまで繰り返す
    Do Until ActiveCell.Value = ""

        'セルの値を取得（検索キー）
        strKey = ActiveCell.Value

        'セルの行を取得
        nRow = ActiveCell.Row

        'カラム位置の初期化
        nCol = 0

        '一列目の値が同一ならカット＆ペーストを行う
        Do Until strKey <> Cells(nRow + 1, 1).Value

            'カラム位置をインクリメント
            nCol = nCol + 1

            'セルを選択
            Cells(nRow + 1, 2).Select

            '選択セルを切り取る
            Selection.Cut

            'アクティブセルの最終列を選択
            Cells(nRow, 2 + nCol).Select

            '右側にシフトして挿入する
            Selection.Insert Shift:=xlToRight

            '2列目のデータを最終列に貼り付ける
            Cells(nRow, 1).End(xlToRight).Offset(, 1).Value = _
                                             Cells(nRow + 1, 3).Value

            'アクティブ行の直下の行を削除する
            ActiveCell.Offset(1).EntireRow.Delete

        Loop

        '次の行をアクティブ
        Cells(nRow + 1, 1).Activate

    Loop

End Sub