Need help copying to column to rows

[Diego A via AdminLife]

I need help copying an entire column of information into multiple rows without doing so manually considering that I have over 4000 addresses that need to be arranged into rows. For example:
Column A
1. Smith & Sons
2. 223 5th AVE, New York, NY 11234
3. Phone: (212) 758-0718
4.
5. Joe's Auto
6. 556 60th STREET, Brooklyn, NY 11220
7. Phone: (718) 745-0778

I need this to come out like this:
ColumnA Column B Column C
1. Smith & Sons 223 5th AVE, New York, NY 11234 Phone: (212) 758-0718
2. Joe's Auto 556 60th STREET, Brooklyn, NY 11220 Phone: (718) 745-0778

Any help is appreciated.
Thank You!

 

[Don Guillett]

This should do it where your list is in col H

Sub reorganize()
lsr = Cells(Rows.Count, "h").End(xlUp).Row + 1
For i = 2 To lsr Step 4
x = Cells(Rows.Count, "i").End(xlUp).Row + 1
Range(Cells(i, "h"), Cells(i + 3, "H")).Copy
Cells(x, "i").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=True
Next
End Sub

--
Don Guillett
SalesAid Software
(e-mail address removed)

I need help copying an entire column of information into multiple rows

without doing so manually considering that I have over 4000 addresses that
need to be arranged into rows. For example:

 

[Gord Dibben]

Diego

If data is consistent in groups of three with a blank in between as your
example shows, this macro will do the trick.

When the inputbox comes up, enter 4 to accommodate the blank rows.

Sub ColtoRows()
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
nocols = InputBox("Enter Number of Columns Desired")
If nocols = "" Or Not IsNumeric(nocols) Then Exit Sub
For i = 1 To rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(i, "A").Resize(nocols, 1))
j = j + 1
Next
Range(Cells(j, "A"), Cells(rng.Row, "A")).ClearContents
End Sub

If unfamiliar with macros, visit David McRitchie's "getting started with VBA"
site at

http://www.mvps.org/dmcritchie/excel/getstarted.htm

Gord Dibben Excel MVP