Sub Test()
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 3 To iLastCol - 1 Step 2
Cells(1, i).Resize(iLastRow, 2).Copy Cells(iLastRow * (i \ 2) + 1,
"A")
Next i
Columns(3).Resize(, iLastCol - 2).Delete

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"mar10" wrote in message
ups.com...
I'm trying to create a macro that will move 2 columns of data below
another 2 columns of data. This will then be repeated for a number of
columns so that I get all my data into one just two columns.

There will always be data in each cell, however, the number of rows
that will need to be copied will vary. And this is what is causing my
problems.

I'm recording the Macro with Relative reference turned ON. I believe
this statement is what is what is causing my problem but I'm unsure
how to correct:

ActiveCell.Range("A1:B2").Select

Each time I execute the macro I will want to copy a different number of
rows. I believe this statement is limiting my copy to just 2 rows.

Any suggestions would be appreciated.

Thanks



START DATA
A B C D E F
1 2 3 4 5 6
1 2 3 4 5 6

FINISH DATA
A B C D E F
1 2
1 2
3 4
3 4
5 6
5 6


CURRENT MACRO
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:B2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:B2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
End Sub