Hi Pete,

Try this:

Sub CopyEvenToOdd()
'
Range("A2").Select
Do
Range(ActiveCell, ActiveCell.Offset(0, 8)).Select
Selection.Copy
ActiveCell.Offset(-1, 0).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
ActiveCell.Offset(3, 0).Select
Loop Until IsEmpty(ActiveCell)
Range("A1").Select
Application.CutCopyMode = False
End Sub

Hoop This Helps,


Executor