Copy nth Row

[Lawrences]

I have searched extensively for a macro I need however I am unable to find one. Here is my problem.
I want to copy every 5th row starting from row 35 and paste it into a new sheet. Each row needs to be offset by 2 so that there is a gap between the newly pasted rows. I then need to average Every 3rd and 4th Row and paste it after every 5th row.

Put simply, here are the first few rows (only first column included for simplicity)

0
0.2
0.4
0.6
0.8
1.0
1.2
1.4
1.6
1.8
2.0
...


I then want the following in the sheet called 'summary'

0
0.5
1.0
1.5
2.0

How would I do this? Any help appreciated.

 

[bbott]

Assuming that your raw data is in the first sheet, try this:

Sub Every6()

    Dim x As Long
    Dim y As Long
    
    On Error GoTo 500
    For x = 35 To Range("A" & Rows.Count).End(xlUp).Row Step 5
        y = Sheets("summary").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets("summary")
            .Range("A" & y).Offset(1, 0) = Sheets(1).Range("A" & x)
            .Range("A" & y).Offset(2, 0) = WorksheetFunction.Average _
            (Sheets(1).Range("A" & x).Offset(2, 0), Sheets(1).Range("A" & x).Offset(3, 0))
        End With
    Next x
500
End Sub

 

[alansidman]

Try this:

O

ption Explicit


Sub foo()
Dim w1 As Worksheet, w2 As Worksheet
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
Dim lr As Long, i As Long
lr = w1.Range("A" & Rows.Count).End(xlUp).Row
Dim lr2 As Long
Dim sum1 As Double
Dim avg1 As Double




Application.ScreenUpdating = False
For i = 35 To lr
lr2 = w2.Range("A" & Rows.Count).End(xlUp).Row
w1.Range("A" & i).Copy w2.Range("A" & lr2 + 1)
sum1 = WorksheetFunction.Sum(w1.Range("A" & i + 2), w1.Range("A" & i + 3))
avg1 = sum1 / 2
w2.Range("A" & lr2 + 2) = avg1
i = i + 4
Next i


Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "completed"


End Sub

 

[Lawrences]

It works perfectly considering what I asked for so thanks for that! I changed it a bit as I actually need to copy the range A:I however I tried that and it does not work now. Works perfectly fine if I leave it as column "A". Howcome?

Sub Every6()
    Dim x As Long
    Dim y As Long
    
    On Error GoTo 1500
    For x = 35 To Range("A:I" & Rows.Count).End(xlUp).Row Step 5
        y = Sheets("summary").Range("A:I" & Rows.Count).End(xlUp).Row
        With Sheets("summary")
            .Range("A:I" & y).Offset(1, 0) = ActiveSheet.Range("A:I" & x)
            .Range("A:I" & y).Offset(2, 0) = WorksheetFunction.Average _
            (ActiveSheet.Range("A:I" & x).Offset(2, 0), ActiveSheet.Range("A:I" & x).Offset(3, 0))
        End With
    Next x
1500
End Sub

 

[alansidman]

In my code if you want to expand the range, then use

Range("A" & i & ":I" & i)

 

[C Moore]

I think the modification to alansidman's code would be something like this.

Sub Every6()
    Dim x As Long
    Dim y As Long
    Dim i As Long
    
    On Error GoTo 500
    For x = 35 To Range("A" & Rows.Count).End(xlUp).Row Step 5
        y = Sheets("summary").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets("summary")
            For i = 0 To 8 
            .Range("A" & y).Offset(1, i) = Sheets(1).Range("A" & x).Offset(0, i)
            .Range("A" & y).Offset(2, i) = WorksheetFunction.Average _
            (Sheets(1).Range("A" & x).Offset(2, i), Sheets(1).Range("A" & x).Offset(3, i))
            Next i
        End With
    Next x
500
End Sub

 

[Lawrences]

Thanks alansidman. I am actually having trouble fitting that in the code. As the range changes from
Range("A" & i + 2)
to
Range("A" & i + 3))

 

[Lawrences]

Worked brilliantly! Thanks so much