Using the Transpose tool in Excel for a large column of values

Question

What I have is a very large worksheet of data of names and addresses. Right now, it looks similar to:

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

There are hundreds upon hundreds of groups like this, all separated by at least one blank row. Now, I can use the transpose tool by hand, but this would take me quite some time. I thought about just writing a Macro to do it, however some addresses are three lines whereas some are four lines, so it confuses me on if that is even possible.

Any simple ways to do this without having to do all of it by hand?

Answer 1

Now, i assume that you want the end result to look similar to the below with no lines in between individuals and the full address on one line in one cell

Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address

i am also going to assume that your data starts in cell A1 and that every name is unique. if it does not then the macro will need some minor tweaking. set Stopper = 50000 to the row after your last set of data, otherwise this could go on far longer than necessary (or not long enough perhaps).

Sub CollectThem()
    Dim All As New Collection
    Dim One As Variant
    Dim Addy As Variant, Stopper As Long, L1 As Integer

    Stopper = 645

    Cells(1, 1).Select
    Do Until ActiveCell.Row >= Stopper
        ReDim One(0 To 2)
        One(0) = ActiveCell.Offset(0, 0).Value
        One(1) = ActiveCell.Offset(0, 1).Value
        Addy = ""
        Do Until ActiveCell.Row >= Stopper Or (ActiveCell.Value <> "" And ActiveCell.Value <> One(0))
            Addy = Addy & ActiveCell.Offset(0, 2).Value & "|"
            ActiveCell.Offset(1, 0).Select
        Loop
        One(2) = Trim(Addy)
        All.Add One
        Erase One
    Loop

    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select

    Cells(1, 1).Select
    For Stopper = 1 To All.Count
        One = All(Stopper)
        ActiveCell.Offset(0, 0).Value = One(0)
        ActiveCell.Offset(0, 1).Value = One(1)
        Addy = Split(One(2), "|")
        If IsArray(Addy) Then
            For L1 = 0 To UBound(Addy)
                ActiveCell.Offset(0, 2 + L1).Value = Addy(L1)
            Next L1
            Erase Addy
        Else
            ActiveCell.Offset(0, 2).Value = One(2)
        End If
        ActiveCell.Offset(1, 0).Select
        Erase One
    Next Stopper
End Sub