Ajouter 3 lignes au dessous de la cellule sélectionnée

Bonjour,

Je recherche un code VBA qui lorsque je clique sur un bouton, il ajoute 3 lignes vides au dessous de la cellule sélectionnée.

Avez-vous une astuce qui pourrait m'aider?

Meilleures salutations,

Thierry

Bonjour,

ric

Hello

essai ce code à placer dans la feuil1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("a2:a" & Range("a65536").End(xlUp).Row + 1)) Is Nothing And Target.Cells.Count = 1 Then
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End Sub

Excuses

Je viens de voir que tu les veux en-dessous et pas au-dessus comme je l'ai proposé.

Bonjour Thierry36, dan67, le forum,

Un essai par double-clic dans la colonne A....pour suivre l'idée de dan67...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
     If Target.Count > 1 Then Exit Sub
        Target.Rows.Offset(1, 0).Resize(3).Insert Shift:=xlDown
    End If
End Sub

Par bouton (il faut sélectionner une cellule au préalable)...

Sub insertion()
 ActiveCell.Rows.Offset(1, 0).Resize(3).Insert Shift:=xlDown
End Sub

Cordialement,

J'allais proposer cette façon de faire, toujours par double clic

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Cut
    ActiveCell.Offset(2, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Merci pour vos messages. J'ai trouvé ce code pour n'insérer qu'une seule ligne:

'Pour insérer une ligne

Sub insertionLigne()
With ActiveCell
.EntireRow.Insert xlShiftDown 'Insert une ligne au dessus
End With
End Sub

Est-ce qu'il est possible de le modifier simplement pour qu'il insère 3 lignes au lieu d'une seule ?

Re,

Est-ce qu'il est possible de le modifier simplement pour qu'il insère 3 lignes au lieu d'une seule ?

As-tu testé les propositions qui t'ont été soumises ?

Cordialement,

Oui mais je ne souhaite pas passer par un double-clique mais par un bouton.

Re,

Oui mais je ne souhaite pas passer par un double-clique mais par un bouton.

Je te l'avait déjà proposé...mais .l'insertion ne se faisait que sur la colonne de la cellule....

Sub insertion()
 ActiveCell.Offset(1, 0).Rows.Resize(3).Insert Shift:=xlDown
End Sub

Il faut sélectionner une cellule au préalable...

Sub insertion2()
 ActiveCell.Offset(1, 0).EntireRow.Resize(3).Insert Shift:=xlDown
End Sub

Cordialement,

Effectivement je souhaite insérer une ligne entière plutôt qu'une seule cellule en dessous de celle sélectionnée.

Re,

Effectivement je souhaite insérer une ligne entière plutôt qu'une seule cellule en dessous de celle sélectionnée.

Tu veux dire 3 lignes entières en dessous de la cellule sélectionnée.........donc.....

Sub insertion2()
 ActiveCell.Offset(1, 0).EntireRow.Resize(3).Insert Shift:=xlDown
End Sub

As-tu essayé le fichier que je t'ai joint ?

Cordialement,

Vous êtes incroyable ça fonctionne à merveille!

Je vous remercie beaucoup pour votre aide et vous souhaite de belles fêtes de fin d'année!

Ouf......enfin !

Bonnes fêtes également ,