Sub ColtoRows()
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error Resume Next
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

Enter 6 in the "Number of Columns" inputbox.

Assumes there is no data in columns E and F

Of course you could first get rid of the blank rows by
F5SpecialBlanksOKEditDeleteEntire Rows
Then enter 4 in "Number of Columns"


Gord Dibben MS Excel MVP

On 13 Nov 2006 14:35:23 -0800, "drakehouse" wrote:

I've tried the offset command and a loop macro (which it's been several
years, so have been unsucessful) for the following scenario:

In column A, I have several contacts pasted in address label format.
I'd like to get them in column format. Column A currently looks like:

John Doe
123 Anywhere Lane
Mountains, CA 95555
(555) 555-5555


Jane Doe
1111 Anywhere Lane
Oceans, CA 97777
(555) 555-7777

There are two blank rows between the two contacts, which is what is
hanging me up.

Thanks so much!
A