Paste two columns under each other for multiple columns

Hello,

I am new to VBA coding and trying to get things sorted for an excel document (work purpose). Unfortunately I am stuck in a [articular step unable to move forward with my assignment. I would really appreciate any help from anybody.

Here is an example of what I am trying to do - I am looking for a code to paste series of 2 columns under each other (variable length).

Ex:

Sheet1

1 Col 1 Col 2 Col 3 Col 4
2 ABC DEF GHI JKL
3 MON PQR STU VWX
4 YZA BCD EFG GIJ
5 KLM NOP QRS TUV
6 WXY ZAB CDE FGH

I want it as -


1 Col1 Col2
2 ABC DEF
3 MON PQR
4 YZA BCD
5 KLM NOP
6 WXY ZAB
7 GHI JKL
8 STU VWX
9 EFG GIJ
10 QRS TUV
11 CDE FGH



for variable rows. The number of rows is not fixed.

I have a code but that is to paste one column below each other. Please help me tweak this code for my need.

Sub OneColumnV2()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''
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

Kindly help me with this, I appreciate any help from anybody.