Hi

Try this:

Sub Move_Lists()
Dim NewRow As Long, NewColumn As Long
Dim X As Long
NewRow = 1
NewColumn = 16
If Cells(NewRow, NewColumn).Value < "" Then
NewColumn = Cells(1, Columns.Count).End(xlToLeft).Offset(0,
1).colunm
End If
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
Next
End Sub

Regards.
Per


On 8 Dec., 04:12, oldjay wrote:
Thanks for all the help past and future

Again I didn't state everything. The following macro copies all columns in a
range to a single column (16). If after the copy to col16 I might run the
Macro again but i want to place all the cells in the next column. All column
to the right of 16 are blank. Each time I run the macro it should place all
the cells in the next empty column.

oldjay

Sub Move_Lists()
Dim NewRow As Long, NewColumn As Long
Dim X As Long
NewRow = 1
NewColumn = 16
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
Next

End Sub



"OssieMac" wrote:
We meet again oldjay. Could become a habit.

Not really sure of what you want so here are 2 answers depending on the
meaning of your question.

If you mean the cell after the last cell with data and there are no more
cells in row 1 with data then the following finds the blank cell at the end
of the data.

Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Select

If there is likely to be more cells with data after the first blank cell
then the following.

Dim i As Long

For i = 17 To Columns.Count
* If IsEmpty(Cells(1, i)) Then
* * Cells(1, i).Select
* * Exit For
* End If
Next i

--
Regards,

OssieMac- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -