Doubler les lignes contenant le nombre 1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
nombre = Range("n2")
Target.EntireRow.Resize(rowsize:=nombre).Insert Shift:=xlDown
Cancel = True
End Sub

Sub DoublementLignes()
Dim L As Long
For L = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
   If Cells(L, "D").Value = 1 Then
      Rows(L).Copy
      Rows(L).Insert: End If: Next L
End Sub

Sub DoublementLignes()
Dim lig, col, nb As Long
Dim cel As Range
Sheets("Feuil8").Activate
With ActiveSheet
For Each cel In .Range("d2:d1002")
If cel Like "*1" Then
nb = .Range("f1")  ' nombre de lignes à inserer
cel.Offset(1, 3).EntireRow.Resize(rowsize:=nb).Insert Shift:=xlDown
End If
Next cel
For lig = 2 To .Range("a65536").End(xlUp).Row
For col = 1 To 4
If .Cells(lig, col) = "" Then
.Cells(lig, col) = .Cells(lig - 1, col)
End If
Next col
Next lig
End With
End Sub