Vertical Database to Horizontal?

[Valerie]

I have about 3,300 names, addresses, phones in a spreadsheet vertically
(column A1, A2, . . . to A7). The name is in one cell (A1), the address is
below (A2), the phone is next (A3). They are alpha sorted but all in one
column with NO rows between them. I can copy and paste special - transpose
for each record to make it be horizontal but it is slow going.
Since they are alpha sorta, I tried: If the word begins with an "A" , bring
back the cell's value but it does not seem to work.

Is there a way to bring the 7 elements of each record from vertical (7 rows)
to horizontal (7 columns)?

Thank you

 

[Valerie]

I have about 3,300 names, addresses, phones in a spreadsheet vertically
(column A1, A2, . . . to A7). The name is in one cell (A1), the address is
below (A2), the phone is next (A3). They are alpha sorted but all in one
column with NO rows between them. I can copy and paste special - transpose
for each record to make it be horizontal but it is slow going.
Since they are alpha sorta, I tried: If the word begins with an "A" , bring
back the cell's value but it does not seem to work.

Is there a way to bring the 7 elements of each record from vertical (7 rows)
to horizontal (7 columns)?

Also, I have tried Transpose but it only brings back the same cell value
and does not advance downward to the next cell. Even though there is no $
before the column or row values, if I copy the Transpose to the right (for
horizontal) it brings back only the array in the first cell for all 7 columns.

 

[Otto Moehrbach]

Valerie
This short macro will do that for you. This macro operates on the active
sheet so make sure the sheet will all the data is the active sheet. I wrote
the code to put the final product in a sheet named "After", so you need to
create that sheet. I assumed your data is in Column A starting with A1.
The final product will go to Columns A:G of the After sheet. HTH Otto
Sub ReArrange()
Dim c As Long, LastC As Long
Dim Dest As Range
LastC = Range("A" & Rows.Count).End(xlUp).Row
Set Dest = Sheets("After").Range("A1")
Application.ScreenUpdating = False
For c = 1 To LastC Step 7
Range(Cells(c, 1), Cells(c + 6, 1)).Copy
Dest.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Set Dest = Dest.Offset(1)
Next c
Application.ScreenUpdating = True
End Sub

 

[Valerie]

It works! You are amazing, incredible macro. Thank YOU so much! You have
saved me so much time. Just amazing. Thanks!

 

[Otto Moehrbach]

Glad to help. Thanks for the feedback. Otto

It works! You are amazing, incredible macro. Thank YOU so much! You
have
saved me so much time. Just amazing. Thanks!