The following macro should do this for you. I'm assuming that all the
data is in column A and the rest of the sheet is empty

Sub Reformat()
LastRow = Cells(65536, 1).End(xlUp).Row
For N = LastRow To 1 Step -1
If Application.CountIf(Range(Cells(1, 2), Cells(LastRow, 256)),
Cells(N, 1)) 0 Then
Cells(N, 1).Delete shift:=xlUp
Else
ItemCount = Application.CountIf(Columns(1), Cells(N, 1))
If ItemCount 1 Then
If Cells(1, ItemCount) = "" Then
Cells(1, ItemCount) = Cells(N, 1)
Else
Cells(65536, ItemCount).End(xlUp).Offset(1, 0) =
Cells(N, 1)
End If
Cells(N, 1).Delete shift:=xlUp
End If
End If
Next N
End Sub


--
mrice


------------------------------------------------------------------------
mrice's Profile: http://www.excelforum.com/member.php...o&userid=10931
View this thread: http://www.excelforum.com/showthread...hreadid=533627