Ajout de ligne apres chaque ligne

Bonjour,

J'ai une liste excel et j'aimerais qu'à l'aide d'une macro après chaque ligne j'ajoute une ligne Commentaires : et une autre ligne en dessous Nom / Signature.

Je me demandais comment faire ma loop pour qu'àpres chaque ligne initial du tableau on ajoute ces deux champs.

J'ai essayé avec un rows.count et ensuite ajout des lignes mais comme à chaque itération le Rows.count augmente de 2 ca ne fonctionne pas

Merci de vos conseils

Bonjour

Essaie cela :

Sub ajout()
Set ws = Sheets("Feuil1")
dlig = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
i = 2
While i <= dlig
    Rows(i + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i + 1, 1) = "Commentaire :"
    Rows(i + 2).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i + 2, 1) = "Nom / Signature :"
    Cells(i + 2, 6) = "Date :"
    i = i + 3
    dlig = dlig + 2
Wend
End Sub

A+

Bonjour oly111 et Patty5046,

J'ai été moins rapide.

Voici ma contribution à améliorer.

Cdt

Henri

Bonjour

je pense que ses plus simple a l'envers

A+

Maurice

Sub TestInsert()
Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For L = Nlig To 3 Step -1
        Rows(L).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & L) = "Nom / Signature:"
        Range("F" & L) = "Date:"
        Rows(L).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & L) = "Commentaires:"
    Next
End Sub

Bonjour à tous,

Pour ne pas être en reste, voici ma version 2 qui rejoint les versions de Patty5046 et d'archer.

Cdt

Henri

c'est excellent oui par en arriere c'est plus simple Merci à tous ! Vrm simpa