mcadamsjustin
mcadamsjustin

Reputation: 361

Copy every n of cells every n of columns and paste in a new row, for every row

enter image description here

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

Answers (2)

Cyril
Cyril

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

Miles Fett
Miles Fett

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

Related Questions