How to duplicate multiple rows based on cell values

[JWPE]

Hello Everybody,

I currently have a macro below that has worked great.
I had to add in an extra column recently, so now the quantity is sourced from column H instead of column G.
I tried to make the adjustments to the formula but I was unsuccessful.
Columns A-G now need to be duplicated based off column H
Columns I and J are used in conjunction with columns A & G, but do not need to be duplicated.
Having the data populate in M
Can someone guide me through this?
Thanks in advance

Sub DuplicateMultipleRows_2()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, k As Long, x As Long, lr As Long, m As Long

lr = Range("G" & Rows.Count).End(3).Row
a = Range("A2:G" & lr).Value
x = WorksheetFunction.Sum(Range("G2:G" & lr))
ReDim b(1 To x, 1 To UBound(a, 2))

For i = 1 To UBound(a, 1)
For j = 1 To a(i, 7)
k = k + 1
For m = 1 To UBound(a, 2)
b(k, m) = a(i, m)
Next
Next
Next

Range("M2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[Trebor76]

Hi JWPE,

Try this:

Option Explicit
Sub DuplicateMultipleRows_3()

    'https://www.mrexcel.com/board/threads/how-to-duplicate-multiple-rows-based-on-cell-values.1218604

    Dim a As Variant, b As Variant
    Dim i As Long, j As Long, k As Long, x As Long, lr As Long, m As Long
    
    Application.ScreenUpdating = False
    
    lr = Range("H" & Rows.Count).End(3).Row
    a = Range("A2:H" & lr).Value
    x = WorksheetFunction.Sum(Range("H2:H" & lr))
    ReDim b(1 To x, 1 To UBound(a, 2))
    
    For i = 1 To UBound(a, 1)
        For j = 1 To a(i, UBound(a, 2))
            k = k + 1
            For m = 1 To UBound(a, 2)
                b(k, m) = a(i, m)
            Next m
        Next j
    Next i
    
    Range("M2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert