Option Explicit
Sub testme()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim HowManyPerGroup As Long
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

HowManyPerGroup = 5

With wks
FirstRow = 1 ' no headers
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step HowManyPerGroup
.Cells(iRow, "A").Resize(HowManyPerGroup, 1).Copy
.Cells(iRow, "B").PasteSpecial Transpose:=True
Next iRow

'clean up original data
.Columns(1).Delete

'clean up empty rows
On Error Resume Next
.Columns(1).Cells.SpecialCells(xlCellTypeBlanks).E ntireRow.Delete
On Error GoTo 0

End With

End Sub

PhooPhan wrote:

I have a worksheet with over 2000 rows of information but it's all
symmetrical. Meaning, Row 1 is a Company Name. Row 2 is the Street Address.
Row 3 is the City, State, Zip. Row 4 is the Phone Number. Row 5 is the Fax
Number. Then Row 6 starts the next Company Information in the same order. I
want to sort this information into Columns so that Column 1 is Company Name,
Column 2 is Street Address, etc.

Does anyone know how this can be done? Thank you.

--

Dave Peterson