Dupliquer les lignes en fonction des valeurs d'autres cellules amélioration

Bonjour, je viens pour solliciter votre aide car je suis dans l'urgence.

J'ai un programme qui me permet de dupliquer les lignes en fonction des valeurs situées dans la colonne D. Mon problème avec ce code est que lorsque plusieurs chiffres se suivent le code ne duplique plus toutes les lignes un peu comme si il sautait des lignes.

Voici le code : pourriez-vous m'aider à l'améliorer ? Je joins également un fichier exemple. Merci pour votre aide.

Option Explicit

Sub Test()
Dim i%, j%, ligne%, Dl%
Dim Ws As Worksheet
Set Ws = Sheets("Feuil1")
i = 2
Do While Ws.Cells(i, 1) <> ""
j = Ws.Cells(i, 4) - 1
If j > 0 Then
For ligne = i To i + j
Ws.Range("A" & i + 1 & ":F" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Ws.Range("A" & i & ":F" & i).Copy Ws.Range("A" & i + 1 & ":F" & i + 1)
Ws.Range("D" & i & ":D" & i).Value = 1
Next ligne
i = i + j + 1
Rows(i).EntireRow.Delete
End If
i = i + 1
Loop
End Sub

Bonjour,

A tester avec une petite modif

J'ai vu la ligne qui a été modifiée merci encore pour votre aide. Cela a résolu mon problème.