Forum Discussion

Copper Contributor

Oct 28, 2020

Solved

Macro/VBA code to duplicate every N-th row, N times

Hi, I'm a newbie to VBA and macro so I need help with a script/code that can duplicate every 17th row, four number of times. This should be a loop. I have attached a part of my dataset. I wan...

Oct 28, 2020

Here is a macro:

Sub InsertRows()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    m = ((m - 1) \ 17) * 17 + 1
    For r = m To 18 Step -17
        Range("A" & r).EntireRow.Copy
        Range("A" & r + 1).Resize(4).EntireRow.Insert
    Next r
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

HansVogelaar

MVP

Oct 28, 2020

ushbar

Here is a macro:

Sub InsertRows()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    m = ((m - 1) \ 17) * 17 + 1
    For r = m To 18 Step -17
        Range("A" & r).EntireRow.Copy
        Range("A" & r + 1).Resize(4).EntireRow.Insert
    Next r
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

ushbar

Copper Contributor

Oct 28, 2020

HansVogelaar

Thanks a lot for your quick response! That worked!

I actually want to replace the four new rows with the following values in the "Allergener" column:

Paranøtter

Pekannøtter

Pistasjnøtter

Valnøtter

And column L-O should be empty for the four new columns.

This should again be a loop similar to the original post.

Do you have any code for this?

The duplicated rows from the code above do not always have the same values because the 17th row sometimes have a different value throughout the dataset. That's why a code would be more efficient than doing it manually.

HansVogelaar

MVP

Oct 28, 2020

ushbar

Sub InsertRows()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    m = ((m - 1) \ 17) * 17 + 1
    For r = m To 18 Step -17
        Range("A" & r).EntireRow.Copy
        Range("A" & r + 1).Resize(4).EntireRow.Insert
        Range("I" & r + 1).Value = "Paranøtter"
        Range("I" & r + 2).Value = "Pekannøtter"
        Range("I" & r + 3).Value = "Pistasjnøtter"
        Range("I" & r + 4).Value = "Valnøtter"
    Next r
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub