Transpose cells

[GWC]

If the first 10 characters in A2 equal the first 10 characters in A1, how can I 'transpose' the contents of A2 to B1 and then do the same for the remaining cells in Col A?

Here is my spreadsheet:

00002606601984
00002615461966
00002682821978
00002723261973
00002842461966
00002962431966
00003189361981
00003252911984
00003253011967
00003288181981
00003370121981
00003394341967
00003394341968
00003394341969
00003613051981
00003627191981
00003811921982
00004041781982
00004043431969
00004106231982
00004106231983
00004946811985
00004991811985
00005485191985
00005521691984
00006011681986
00006011681987
00006267181990
00006288221986
00010823261993
00012769381998
00012918411998
00012918411999
00012918412000
00012918412001
00012918412002


==============

Here are the results I'm looking for:

00002606601984
00002615461966
00002682821978
00002723261973
00002842461966
00002962431966
00003189361981
00003252911984
00003253011967
00003288181981
00003370121981
00003394341967 00003394341968 00003394341969
00003613051981
00003627191981
00003811921982
00004041781982
00004043431969
00004106231982 00004106231983 00004946811985
00004991811985
00005485191985
00005521691984
00006011681986 00006011681987
00006267181990
00006288221986
00010823261993
00012769381998
00012918411998 00012918411999 00012918412000 00012918412001 00012918412002
00002606601984
00002615461966
00002682821978
00002723261973
00002842461966
00002962431966
00003189361981
00003252911984
00003253011967
00003288181981
00003370121981
00003394341967 00003394341968 00003394341969
00003613051981
00003627191981
00003811921982
00004041781982
00004043431969
00004106231982 00004106231983
00004946811985
00004991811985
00005485191985
00005521691984
00006011681986 00006011681987
00006267181990
00006288221986
00010823261993
00012769381998
00012918411998 00012918411999 00012918412000 00012918412001 00012918412002

 

[Ben McClave]

Hello,

This macro worked for me. It will go down the entire column of data in column A and build a list in column B (and others as necessary). Once the list is complete, column A is deleted.

Hope this helps,

Ben

Sub TransposeIt()
Dim rList As Range
Dim lCol As Long
Dim lRow As Long
Dim c As Range

Set rList = Range("A1:" & Range("A" & Rows.Count).End(xlUp).Address)
lCol = 1
lRow = 1

For Each c In rList
If lCol = 1 Then
lCol = lCol + 1
ElseIf Left(c.Value, 10) = Left(c.Offset(-1, 0).Value, 10) Then
lCol = lCol + 1
Else
lCol = 2
lRow = lRow + 1
End If
Cells(lRow, lCol).Value = c.Value
Next c

Range("a1").EntireColumn.Delete
ActiveSheet.UsedRange.EntireColumn.AutoFit

Set rList = Nothing

End Sub