Last thing (I hope)
I can't any way to also copy the formats.
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value

"OssieMac" wrote:

Hello again oldjay,

I don't know if the code that I have included to "Ensure first run of code
will start at column 16" is required or not. If you have any blank columns
between the end of your other data and column 16 then it is required but it
won't matter either way if it remains.

Sub Move_Lists()
Dim NewRow As Long
Dim NewColumn As Long
Dim Col As Long
Dim X As Long

NewRow = 1

'Use the following code to find first
'unused column
NewColumn = Cells(1, Columns.Count) _
.End(xlToLeft).Offset(0, 1).Column

'Ensure first run of code
'will start at column 16
If NewColumn < 16 Then
NewColumn = 16
End If

'NewColumn = 16 'Don't use this line

For Col = 1 To 9
For X = 2 To 31
If Cells(X, Col) < "" Then
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value
NewRow = NewRow + 1
End If
Next X
Next Col

End Sub

--
Regards,

OssieMac