XL 2019 Insertion de lignes simples

[bambi]

Bonjour à tous
J'ai une petite demande VBA
J'ai un tableau avec des données à traiter
Pour simplifier cela, j'ai besoin d'insérer 4 lignes vides en dessous de chaques lignes existantes
Manuellement, c'est fastidieux
Donc si l'un d'entre vous avait une macro, je lui en serais reconnaissante
Je joint un fichier modèle
Merci d'avance

 

[patty58]

Bonjour

Essaie cela :

Sub Ajout_Lignes()
DLig = Range("A65536").End(xlUp).Row
L = 2
For ind = 1 To DLig
    For iCpt = 0 To 3
        Rows(L & ":" & L).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next iCpt
    L = L + 5
Next

End Sub

Bonne soirée

 

[bambi]

Merci beaucoup @patty58
C'est parfait, tu me fais gagner un temps précieux
Très bonne soirée

 

[cp4]

Bonsoir @bambi , @patty58 ,

Je l'ai fait, je le joins. Patty58 a été plus rapide

Option Explicit

Sub essai()
Dim i As Long
With Sheets("Feuil1")
i = 1
    Do While Cells(i, 1) <> ""
        .Rows(i + 1).Resize(4).Insert Shift:=xlDown
    i = i + 5
    Loop
End With
End Sub

Bonne soirée.

 

[Eric C]

Bonsoir le forum
Bonsoir bambi, bonsoir patty58, bonsoir cp4

patty58 & cp4 : Petit plus , une petite ligne à ne pas oublier pour éviter le scintillement dû à l'exécution de la macro :
Application.ScreenUpdating = False
Et surtout, rétablir en fin de macro
Application.ScreenUpdating = True

Bonne soirée à toutes & à tous

@+ Eric c

 

[bambi]

Merci @cp4 et @Eric C