VBA - Copy, and then Paste to every other cell

[stemby]

I am trying to copy a range from 'Sheet1' and paste the data into 'Sheet2' but into every other row.

Sub testcopy()
'
' testcopy Macro
    Sheets("Sheet1").Select
    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

This code works for the copy and paste, but how can I adapt it so it pastes to every other cell down? I think it may be to do with an 'offset' but can't figure out how to code it.

Thanks.

 

[Joe4]

Can you show us an example of what the data you are copying looks like, and what you expect that final result to look like?

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[stemby]

It's OK, I think I've got it... something along these lines...

Sub testcopy()
    Dim wsSrc As Worksheet, wsDst As Worksheet, aCell As Range, tOff As Long
    
    Set wsSrc = Worksheets("Sheet1")
    Set wsDst = Worksheets("Sheet2")
    
        For Each aCell In wsSrc.Range("I3:I11").Cells
            wsDst.Range("B30").Offset(tOff, 0).Value = aCell.Value
            tOff = tOff + 2

        Next aCell

End Sub