Copy nth Row

Lawrences

New Member
Joined
Aug 10, 2014
Messages
45
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.
 

Some videos you may like

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
Joined
Feb 5, 2010
Messages
2,350
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
Joined
Feb 26, 2007
Messages
5,852
Office Version
  1. 2019
Platform
  1. Windows
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
Joined
Aug 10, 2014
Messages
45
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
Joined
Feb 26, 2007
Messages
5,852
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

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

C Moore

Well-known Member
Joined
Jan 17, 2014
Messages
539
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Aug 10, 2014
Messages
45
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))
 

Watch MrExcel Video

Forum statistics

Threads
1,108,708
Messages
5,524,431
Members
409,577
Latest member
Dwg

This Week's Hot Topics

Top