insertion Lignes

Sub Insertion_lignes()
Dim r As Long
Application.ScreenUpdating = False
r = Range("A65536").End(xlUp).Row
Do Until Cells(r, 1).Row = 1
Cells(r, 1).EntireRow.Insert shift:=xlDown
r = Cells(r, 1).Offset(-1, 0).Row
Loop
Application.ScreenUpdating = true
End Sub

Sub Insertion_lignes()
Dim r As Long
Application.ScreenUpdating = False
r = Range("A65536").End(xlUp).Row
Do Until Cells(r, 1).Row = [B][COLOR=blue]3[/COLOR][/B]
Cells(r, 1).EntireRow.Insert shift:=xlDown
r = Cells(r, 1).Offset([COLOR=blue][B]-2[/B][/COLOR], 0).Row
Loop
Application.ScreenUpdating = true
End Sub