How to transpose multiple cells at once in Excel

Question

I have an Excel document such as this, with many listings:

Name
Address
City, State
ZIP

Name
Address
City, State
ZIP

In between each, there is a blank line. How can I convert it to something like:

Name, Address, City, Sate, ZIP
Name, Address, City, Sate, ZIP

I have done some research and the macros seem to give errors. The special paste also only allows me to do 1 by one.

Answer 1

You don't need macros for this!

Just enter this in Sheet2 and adapt the sheetname in the formulas:

• A1: =OFFSET(Sheet1!$A$1,(ROW()-1)*6,0)
• A2: =OFFSET(Sheet1!$A$1,(ROW()-1)*6+1,0)
• A3: =OFFSET(Sheet1!$A$1,(ROW()-1)*6+2,0)
• A4: =OFFSET(Sheet1!$A$1,(ROW()-1)*6+3,0)
• A5: =OFFSET(Sheet1!$A$1,(ROW()-1)*6+4,0)

Then mark the entries you just made and drag them down as long as needed.. Done!

Answer 2

I answered this a couple of days ago but my answer seems to have been lost. Perhaps I did not post it correctly since I am new to this site.

I have not lived in the States since the late 1970s but our two addresses in Detroit had different numbers of lines. The formula solution relies on every address having the same number of lines so I do not see it as an adequate solution.

I placed the following English addresses in Sheet1. The first is a typical UK address. The other two are real (except for the name and postcode) but less usual. The second is a village-style address with houses named instead of numbered and the local town included in addition to the village name. The third address is most unusual since it has no street name. As the address implies, the house was built into the ruins of what was once the west front of the abbey of Bury St Edmunds.

John Smith
5 Acacia Avenue
York
Yorkshire
YO3 2RG

Sarah Jones
Lilac Cottage
Chapel Lane
Houghton
Huntingdon
Cambridgeshire
CB12 4TG

Alice Green
1 The West Front
Abbey Ruins
Bury St Edmunds
IP33 1RS

The following macro will copy these addresses to Sheet2 in the style you seek.

Sub Test2()

  Dim Col1Crnt As Integer
  Dim Col1Max As Integer
  Dim Col2Crnt As Integer
  Dim Sheet1() As Variant
  Dim Row1Crnt As Integer
  Dim Row1Max As Integer
  Dim Row2Crnt As Integer

  With Sheets("Sheet1")
    ' Find the last used row in Sheet1
    Row1Max = .Cells.Find("*", .Range("A1"), xlFormulas, _
                                            , xlByRows, xlPrevious).Row
    ' Load column 1 to Sheet1.
    Sheet1 = .Range(.Cells(1, 1), .Cells(Row1Max, 1)).Value
    ' Although I am only loading one column, Sheet 1 will be a 2D array
    ' with the row as the first dimension and the column as the second.
    ' I have loaded Sheet1 to an array because switching between
    '  worksheets is very slow.
  End With

  With Sheets("Sheet2")
    Row2Crnt = 1
    Col2Crnt = 1
    For Row1Crnt = 1 To Row1Max
      If Sheet1(Row1Crnt, 1) = "" Then
        ' blank line
        If Col2Crnt <> 1 Then
          ' Only advance row for first blank row
          Row2Crnt = Row2Crnt + 1
          Col2Crnt = 1
        End If
      Else
        .Cells(Row2Crnt, Col2Crnt).Value = Sheet1(Row1Crnt, 1)
        Col2Crnt = Col2Crnt + 1
      End If
    Next
  End With

End Sub

Hope this helps