Reputation: 361
In the above example, I'd like to start in F2, and copy F2,G2 and H2, then paste those values in a new row.I'd like to continue to do that until the last column at the end of the row.I would also be ok if I started in C2 and had to paste in a new sheet. I'd like to continue doing this until the last row is empty.
I've found this, but it only copies every 3rd cell, not a range:
Sub CopyNthData()
Dim i As Long, icount As Long
Dim ilastrow As Long
Dim wsFrom As Worksheet, wsTo As Worksheet
Set wsFrom = Sheets("Sheet2")
Set wsTo = Sheets("Sheet1")
ilastrow = wsFrom.Range("B100000").End(xlUp).Row
icount = 1
For i = 1 To ilastrow Step 3
wsTo.Range("B" & icount) = wsFrom.Range("B" & i)
icount = icount + 1
Next i
End Sub
I assume the best way to do this is through VBA, but I'm a bit of a novice in VBA. Any suggestions would be appreciated.
Upvotes: 0
Views: 271
Reputation: 6829
If I understand your comment correctly, you just want to copy a larger range?
You can do that similar to:
stepCt = 3
lr = stepCt-1
For i = 1 To ilastrow Step stepCt
With wsTo
.Range(.Cells(icount,2),.Cells(icount+lr,2)) = wsFrom.Range(wsFrom.Cells(i,2),wsFrom.Cells(i+lr,2))
End With
icount = icount + stepCt 'Accounts for multiple ROWS
Next i
Can do similar to multiple columns, where instead of adding lr
(last row) to the row argument of Cells()
you can add to the column argument of Cells()
. The use of stepCt
wouldn't be necessary in that case.
Edit1:
Changing to show columns, not rows, as the original question changed from asking for copying F2, F3, & F4
to F2, G2, & H2
.
For i = 1 To ilastrow
With wsTo
.Range(.Cells(icount,6),.Cells(icount,8)).Value = wsFrom.Range(wsFrom.Cells(i,6),wsFrom.Cells(i,8)).Value
End With
icount = icount + 1
Next i
Upvotes: 1
Reputation: 721
I'm not sure this is what you are looking for, but this will paste all data in a range starting from F2 into a new sheet starting in C2.
Sub CopyNthData1()
Dim Source As Range
Set Source = Worksheets("Sheet1").Range(("F2"), Range("F2").End(xlDown).End(xlToRight))
Source.Copy
Dim DestRange As Range
Set DestRange = Worksheets("Sheet2").Range("C2")
DestRange.PasteSpecial xlPasteAll
End Sub
Upvotes: 0