Enhance sub to copy cols of variable length into 1 col to snake results into other cols

[Max]

Using xl2003. My data is around 200+K total. Seeking help to enhance the sub
by Bernie Dietrick below, to snake the results to the next col B (and so on,
as required, to col C, D, etc) once col A in "Alldata" (this sheet is
created by the sub) is filled up to the brim. Thanks.

'--------------
Sub OneColumnV2()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
'Modified 17 FEb 2006 by Bernie Dietrick
''''''''''''''''''''''''''''''''''''''''''
Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim ColNdx As Long
Dim ws As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim myCell As Range

ExcludeBlanks = (MsgBox("Exclude Blanks", vbYesNo) = vbYes)
Set ws = ActiveSheet
iLastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error Resume Next

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = ws.Cells(ws.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = ws.Range(ws.Cells(1, ColNdx), _
ws.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
For Each myCell In myRng
If myCell.Value <> "" Then
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next myCell
Else
myRng.Copy
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next

Sheets("Alldata").Rows("1:1").entirerow.Delete

ws.Activate
End Sub
'----------

 

[Max]

I received marvellous help from Bob Phillips in another forum
(didn't receive any responses here)

Many thanks, Bob. Tested it on my data and it runs wonderful.
(for info, I've been banned from that forum for a month,
seemingly because they took issue with my subject titling**,
so I'm posting here to let you know the result, and to thank you)
**Enhance Sub To Write To Next Col

'------------
Sub OneColumnV3()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
'Modified 17 Feb 2006 by Bernie Dietrick
'Enhanced by Bob Phillips to write results into other cols as may be
required
''''''''''''''''''''''''''''''''''''''''''
Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim jNextCol As Long
Dim ColNdx As Long
Dim ws As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim myCell As Range

ExcludeBlanks = (MsgBox(" Exclude Blanks", vbYesNo) = vbYes)
Set ws = ActiveSheet
iLastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error Resume Next
jNextCol = 1

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = ws.Cells(ws.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = ws.Range(ws.Cells(1, ColNdx), _
ws.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
For Each myCell In myRng
If myCell.Value <> "" Then
myCell.Copy
TargetCell(jNextCol).PasteSpecial xlPasteValues
End If
Next myCell
Else

myCell.Copy
TargetCell(jNextCol).PasteSpecial xlPasteValues
End If
Next

Sheets("Alldata").Rows("1:1").EntireRow.Delete

ws.Activate
End Sub

Private Function TargetCell(ByRef Col As Long) As Range

With Sheets("Alldata")

If .Cells(Rows.Count, Col).Value <> "" Then

Col = Col + 1
RowNum = 1
Else

RowNum = .Cells(Rows.Count, Col).End(xlUp).Row
End If
Set TargetCell = .Cells(RowNum + 1, Col)
End With
End Function
'---------