If there are only a few names, you could do the following from the keyboard:
- Sort the list, if not already sorted.
- Select the numbers against the first name.
- Move to Column C of the first row for the name
- Select Edit, Paste Special, Transpose Values, OK
- Delete all but the first row for the name
- Repeat steps 2 to 5 for all other names
- Delete column B.
If you have lots of names, you will need a VBA solution:
Option Explicit
Sub TransposeColB()
Dim ColCrntNext As Integer ' The next cell on the current row
Dim ColNextLast As Integer ' The last cell on the next row
Dim Offset As Integer ' Offset from first number on row to last
Dim RowCrnt As Integer ' Current row
With Sheets("Sheet1") ' !!!! Replace "Sheet1" with name of your sheet !!!!
' Sort entire sheet in case a partial tranpose has occurred.
.Cells.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
RowCrnt = 1
' Identify first blank cell on row. This ensures nothing is overwritten.
ColCrntNext = .Cells(RowCrnt, Columns.Count).End(xlToLeft).Column + 1
Do While True
' Check name on next row
Select Case .Cells(RowCrnt + 1, "a").Value
Case ""
' The next row has no name. The transpose is complete.
Exit Do
Case .Cells(RowCrnt, "a").Value
' The next row has the same name as the current row. Move its
' numbers to the current row.
' Find last used column on the next row
ColNextLast = .Cells(RowCrnt + 1, _
Columns.Count).End(xlToLeft).Column
Offset = ColNextLast - 2 ' Offset from first number to last.
' Normally zero.
' Move numbers from next row to current
.Range(.Cells(RowCrnt, ColCrntNext), _
.Cells(RowCrnt, ColCrntNext + Offset)).Value = _
.Range(.Cells(RowCrnt + 1, 2), _
.Cells(RowCrnt + 1, 2 + Offset)).Value
.Rows(RowCrnt + 1).EntireRow.Delete ' Delete next row
ColCrntNext = ColCrntNext + Offset + 1 ' Advance to first blank cell
Case Else
' The next row is for a new name
RowCrnt = RowCrnt + 1
' Identify first blank cell on row. This ensures
' nothing is overwritten.
ColCrntNext = .Cells(RowCrnt, _
Columns.Count).End(xlToLeft).Column + 1
End Select
Loop
End With
End Sub