This will do it.

Bob Tulk
MOUS (XP/97)

------------
Sub ToCols()
'While not at the end of the list.
While ActiveCell.Row < 100
'If the next row is empty, we're done with this record.
x = 1
While ActiveCell.Offset(1, 0).Value < ""
ActiveCell.Offset(0, x).Value = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Delete xlUp
x = x + 1
Wend
'Move onto the next record.
ActiveCell.Offset(1, 0).Select
ActiveCell.Delete xlUp
Wend
End Sub
----------

"CarlJ" wrote:

Hello everyone,

I know many may have this same problem, I hope the answer helps a lot of
people.

I have a list of 1000 contacts that are in vertical order, not very
database friendly. I would like to change the contact info so they are in
colums cells not row cells. Some have email address, some dont .
Their is a space between each orginal contact if that helps.I have tried may
methods but none has worked

Example

From this

Joe Smoe
122 W 123 Lake
Phila,Pa 19120
954-633-5656

Billy Bon
122 W 123 Lake
Phila,Pa 19120
954-633-4141

To this

Joe Smoe | 122 W 123 Lake | Philadelphia,Pa 19120 |954-633-5656
Billy Bon | 122 W 123 Lake | Philadelphia,Pa 19120 |954-633-4141

The more suggestions the better . Thank you very much for your help
Carl