Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, n As Long, lig As Long, derlig As Long
Set plage = Range("F2:F" & Rows.Count) 'à adapter
If Intersect(Target, plage) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Not IsNumeric(Target) Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
n = Application.Max(Target - 1, 0) 'si valeur < 0
lig = Target.Row
Cells(lig, plage.Column) = 1
derlig = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
Rows(lig & ":" & derlig).Cut Cells(lig + n, 1) 'Couper-Coller
If Err Then
MsgBox "Insertion de " & n & " lignes impossible, des données sortiraient de la feuille !", 48
Else
Rows(lig + n).Copy Rows(lig).Resize(n)
With Rows(lig).Resize(n + 1, plage.Column) 'plage à mettre en forme
With .Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
.Font.Bold = True
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End If
Application.EnableEvents = True
End Sub