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