Thanks for the reply, This code doesn't limit the rows. I want to copy rows 2
thru 31

"Mike H" wrote:

Hi,

try this it copies the first 10 columns to column 11 omitting blanks

Sub marine()
Dim NewRow As Long, NewColumn As Long
Dim X As Long, Col as Long
NewRow = 1
NewColumn = 11 'Change to suit
For col = 1 To 10
For X = 1 To ActiveSheet.Cells(Rows.Count, col).End(xlUp).Row
If Cells(X, col) < "" Then
Cells(NewRow, NewColumn).Value = Cells(X, col).Value
NewRow = NewRow + 1
End If
Next
Next
End Sub

Mike

"oldjay" wrote:

I have 10 columns with 30 entry cells. Some cells have a single word other
are blank.
I want to copy all words to a single colum and them alphabetize them