Copy range and paste to every nth column

[rjh3m8]

Hi, I am trying to copy a range of data and paste it to every 4th column. For instance, Row 1 has 25 columns of datapoints, I want each datapoint to be 4 columns apart. Then again for Row 2 data... Row 3 data... on and so forth. I have the following code I edited from somewhere else, but it is pasting only one row of data to one column, with each data point spaced 4 rows apart. Can anyone help me see where it's gone wrong?

Sub Copy_Paste_nth()
Dim i As Long, r As Long
Dim Rng As Range

With Sheets("Sheet1")
Set Rng = .Range("A1:Y1", .Range("A" & Rows.Count).End(xlUp))
End With
For i = 2 To Rng.Count * 4 Step 4
r = r + 1
Sheets("Sheet2").Range("C" & i).Value = Rng(r).Value
Next i
End Sub

 

[rollis13]

If I correctly understood your request try this instead:

Option Explicit
Sub Copy_Paste_nth()
    Dim i As Long, r As Long
    With Sheets("Sheet1")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            r = r + 4
            .Range("A" & i & ":Y" & i).Copy Sheets("Sheet2").Range("C" & r)
        Next i
    End With
End Sub

 

[Fluff]

My take on this

Sub rjh3m()
   Dim i As Long, UsdRws As Long
   
   With Sheets("Sheet1")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
         Sheets("Sheet2").Cells(1, i * 4 - 3).Resize(UsdRws).Value = .Cells(1, i).Resize(UsdRws).Value
      Next i
   End With
End Sub

 

[rjh3m8]

My take on this

Sub rjh3m()
   Dim i As Long, UsdRws As Long
  
   With Sheets("Sheet1")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
         Sheets("Sheet2").Cells(1, i * 4 - 3).Resize(UsdRws).Value = .Cells(1, i).Resize(UsdRws).Value
      Next i
   End With
End Sub

This worked really well! In fact, a little too well, as it captured all the data on the first sheet and spaced it out evenly on the second sheet. Can you indicate where I would adjust this to copy only a specific range?

 

[Fluff]

Which range do you want to copy?

 

[rjh3m8]

Which range do you want to copy?

At first, DY2:EW2 to last row
But then I'll need a different set of cells copied and pasted the same way for another iteration elsewhere

 

[Fluff]

Ok, how about

Sub rjh3m()
   Dim i As Long, UsdRws As Long
   
   With Sheets("Sheet1")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 1 To Range("DY2:EW2").Columns.Count
         Sheets("Sheet2").Cells(1, i * 4 - 3).Resize(UsdRws).Value = .Cells(1, i).Resize(UsdRws).Value
      Next i
   End With
End Sub

 

[rjh3m8]

Ok, how about

Sub rjh3m()
   Dim i As Long, UsdRws As Long
  
   With Sheets("Sheet1")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 1 To Range("DY2:EW2").Columns.Count
         Sheets("Sheet2").Cells(1, i * 4 - 3).Resize(UsdRws).Value = .Cells(1, i).Resize(UsdRws).Value
      Next i
   End With
End Sub

I think we're close! This iteration selected the correct number of columns (25 total) but it still started at column A.

 

[Fluff]

Where should they go?

 

[rjh3m8]

Where should they go?

They're going to the right spot; but instead of copying columns DY2:EW2 to last row, it's copying A1:Y1 to last row.