Copy from all rows one Worksheet and paste in to Another in alternate rows(Excel vba)

Question

I have to copy rows from Worksheet A to Worksheet B. However, I have to paste in alternate rows like:

1 st row(Sheet A)-- 1 st row (Sheet B)
2nd row (Sheet A) --> 3rd row (Sheet B)
3rd row (Sheet A)--> 5th row(Sheet B)

Is this possible?

Thanks for your help.

Answer 1

You may try something like this...

Sub CopyRows()
Dim sws As Worksheet, dws As Worksheet
Dim i As Long, lr As Long
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
lr = sws.UsedRange.Rows.Count
dws.Cells.Clear
sws.UsedRange.Copy dws.Range("A1")
For i = lr To 1 Step -1
    dws.Rows(i).Insert
Next i
Application.ScreenUpdating = True
End Sub

Edited Answer:

You may try this approach which will be faster enough to copy the data from Sheet1 into Sheet2. The only downside is it will copy the values only not the formulas if any on Sheet1.

Sub CopyRows()
Dim sws As Worksheet, dws As Worksheet
Dim i As Long, ii As Long, j As Long
Dim x, y()
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
dws.Cells.Clear
x = sws.Range("A1").CurrentRegion.Value
ReDim y(1 To UBound(x, 1) * 2, 1 To UBound(x, 2))
For i = 1 To UBound(x, 1)
    j = j + 2
    For ii = 1 To UBound(x, 2)
        y(j, ii) = x(i, ii)
    Next ii
Next i
dws.Range("A1").Resize(UBound(y, 1), UBound(y, 2)).Value = y
End Sub