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

[ushbar]

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 want to duplicate every 17th row because I have a new 'Id' after every 17th row. 

This is a bit urgent so I'm really trying to automate this process. Thanks for any help you can provide!

[#2 · Accepted solution]

@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

[#3]

@Hans Vogelaar 

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.

[#4]

@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