Voici le lien merci.
Private Sub Menu_Click()
Dim TL(1) As Long
'Application.ScreenUpdating = False
derlig = Range("A" & Rows.Count).End(xlUp).Row
n = 4
Do While n <= derlig
L = Range("U" & n)
If L <> "" Then
LD = n + 1
LF = n + L - 1
'ajout x ligne(s)
Rows(LD & ":" & LF).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
'recopie infos BCD, LMN, increment K de 1 a x
Range("B" & n & "
" & n).Copy Range("B" & LD & "
" & LF)
Range("L" & n & ":M" & n).Copy Range("L" & LD & ":M" & LF)
Application.CutCopyMode = False
NPF = 1
LD = LD - 1
LF = LF
For m = LD To LF
Range("AG" & m) = NPF
NPF = NPF + 1
Next m
n = n + L
derlig = Range("A" & Rows.Count).End(xlUp).Row
Else
n = n + 1
End If
Loop
'Application.Calculation = xlCalculationManual
' je veux incrementer
'.Range("AD" & AJ) = .Range("AD" & AJ - 1).Formula + .Range("AD" & AJ - 1)
'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub