# Copy nth Row

#### Lawrences

##### New Member
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.

### Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

#### bbott

##### Well-known Member
Assuming that your raw data is in the first sheet, try this:

Code:
``````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``````

Last edited:

#### alansidman

##### Well-known Member
Try this:

O
Code:
``````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

##### New Member
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?
Code:
``````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

##### Well-known Member

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

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

#### C Moore

##### Well-known Member
I think the modification to alansidman's code would be something like this.
Code:
``````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

##### New Member
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

##### New Member
Worked brilliantly! Thanks so much

Replies
3
Views
54
Replies
4
Views
46
Replies
9
Views
98
Replies
5
Views
259
Replies
5
Views
28