Copy contiguous from one sheet and paste to another every other ro

[Dean]

I am trying to write a macro that copies from Sheet1 contiguous data A1:A30
and paste data to Sheet2 to every other row (ie Sheet1.A1 to Sheet2.A1;
Sheet1.A2 to Sheet2.A3; Sheet1.A3 to Sheet2.A5 and so on). The pasted result
is data with blank cells in between. Thanks in advance.

 

[dmoney]

Sub tst()
Dim s1 As String
Dim s2 As String
s1 = Sheet1.Name
s2 = Sheet2.Name

Sheets(s1).Select

Range("A1").Select
Selection.Copy
Sheets(s2).Select
Range("A1").Select
ActiveSheet.Paste

Sheets(s1).Select
Range("A2").Select
For i = 1 To 30
Application.CutCopyMode = False
Selection.Copy

Sheets(s2).Select
ActiveCell.Offset(2, 0).Activate
ActiveSheet.Paste
Sheets(s1).Select
ActiveCell.Offset(1, 0).Activate
Next i


End Sub


dmoney