Hi Howard,

combined with Garrys suggestion you can try:
Sub CopyCols()
Dim LCol As Integer
Dim LRow As Long
Dim varOut As Variant
Dim i As Integer
Dim j As Integer

With Sheets("Sheet1")
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
j = 1
For i = 1 To LCol
LRow = .Cells(.Rows.Count, i).End(xlUp).Row
varOut = .Range(.Cells(1, i), .Cells(LRow, i))
Sheets("Sheet2").Cells(Rows.Count, j).End(xlUp) _
.Offset(1, 0).Resize(rowsize:=LRow) = varOut
j = j + 2
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2