VBA/Macro to add extra lines from a value

[lee2121]

Hello Everyone.

I have a file which will contain a different amount of rows and values and i want to be able to click a button (macro) which will look at the numeric value in column L and depending on that value it will create and copy the whole row.

Data before:

PL Tray Labels Week 7.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	A	B	C	D	E	F	G	H	I	J	K	L
2	Agapanthus africanus	22528	202407	PL	20240101-01639	23-002	401217	Twister	40	AGA-AF	12345 Acorn	4
3	Kniphofia uvaria	22528	202407	PL	20240101-01639	24-002	452555	Poco Citron	40	KNI-UV	56789 Blueberry	1
Sheet1

Data result if possible:

PL Tray Labels Week 7.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	A	B	C	D	E	F	G	H	I	J	K	L
2	Agapanthus africanus	22528	202407	PL	20240101-01639	23-002	401217	Twister	40	AGA-AF	12345 Acorn	4
3	Agapanthus africanus	22528	202407	PL	20240101-01639	23-002	401217	Twister	40	AGA-AF	12345 Acorn	4
4	Agapanthus africanus	22528	202407	PL	20240101-01639	23-002	401217	Twister	40	AGA-AF	12345 Acorn	4
5	Agapanthus africanus	22528	202407	PL	20240101-01639	23-002	401217	Twister	40	AGA-AF	12345 Acorn	4
6	Kniphofia uvaria	22528	202407	PL	20240101-01639	24-002	452555	Poco Citron	40	KNI-UV	56789 Blueberry	1
Sheet2

 

[Joe4]

Here is one way:

Sub MyCopy()

    Dim lr As Long, r As Long, n As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column L with data
    lr = Cells(Rows.Count, "L").End(xlUp).Row
    
'   Loop through rows backwards up to row 2
    For r = lr To 2 Step -1
'       See if value in column L > 1
        n = Cells(r, "L").Value
        If n > 1 Then
'           Insert rows
            Rows(r + 1 & ":" & r + n - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'           Copy values from row down to newly inserted rows
            Rows(r).Copy Rows(r + 1 & ":" & r + n - 1)
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub