Transpose automatically

[mystique07]

I have a list of names and account in different columns. i need to transpose all the account names to one name as mentioned in the below.
each name has different number of accounts to it.

[TABLE="width: 706"]
<colgroup><col><col span="8"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Account[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]atlspmgr2[/TD]
[TD][/TD]
[TD]atlspmgr2[/TD]
[TD]ATLPDBS1[/TD]
[TD]atlspint1[/TD]
[TD]aaipvmgr[/TD]
[TD]aaipvmgr[/TD]
[TD]atlspmgr[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]ATLPDBS1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]atlspint1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]aaipvmgr[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]aaipvmgr[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]atlspmgr[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Banana[/TD]
[TD]safepvmgr[/TD]
[TD][/TD]
[TD]safepvmgr[/TD]
[TD]safeftp[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Banana[/TD]
[TD]safeftp[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Grapes[/TD]
[TD]dcorrpsql[/TD]
[TD][/TD]
[TD]dcorrpsql[/TD]
[TD]secrpsql[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Grapes[/TD]
[TD]secrpsql[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[tonyyy]

mystique07,

If you're comfortable with a vba approach, you might consider the following...

Sub TransposeAccounts_1066307()
Application.ScreenUpdating = False
Dim startRow As Long, endRow As Long, lastRow As Long, i As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
startRow = 2
endRow = 2
For i = 3 To lastRow
    If Cells(i, 1).Value = Cells(startRow, 1).Value Then
        endRow = i
    Else
        Range(Cells(startRow, 2), Cells(endRow, 2)).Copy
        ActiveSheet.Cells(startRow, 4).PasteSpecial Transpose:=True
        startRow = endRow + 1
        endRow = startRow
        Application.CutCopyMode = False
    End If
Next i
End Sub

It's assumed the Names are in Column A and Accounts in Column B, and that Names are sorted.

Cheers,

tonyyy