XL 2010 VBA - Bouton insérer une ligne au format identique à la ligne 6

[tchi456]

Bonjour,

J'ai ce code pour pouvoir insérer une ligne au dessous par un bouton mais je souhaiterais adapter ce code pour que la ligne insérée soit toujours identique à la ligne 6 (même hauteur de ligne, même format, même couleur de remplissage mais sans contenu):

Sub BoutonInserer1LigneVide()
ActiveSheet.Unprotect Password:="."
Application.EnableEvents = False
ActiveCell.Offset(1, 0).EntireRow.Resize(1).Insert Shift:=xlDown
Application.EnableEvents = True
ActiveSheet.Protect Password:="."
End Sub

Avez-vous une astuce qui pourrait m'aider?

Mes meilleures salutations,

Thierry

 

[Jacky67]

Bonjour,

J'ai ce code pour pouvoir insérer une ligne au dessous par un bouton mais je souhaiterais adapter ce code pour que la ligne insérée soit toujours identique à la ligne 6 (même hauteur de ligne, même format, même couleur de remplissage mais sans contenu):

Sub BoutonInserer1LigneVide()
ActiveSheet.Unprotect Password:="."
Application.EnableEvents = False
ActiveCell.Offset(1, 0).EntireRow.Resize(1).Insert Shift:=xlDown
Application.EnableEvents = True
ActiveSheet.Protect Password:="."
End Sub

Avez-vous une astuce qui pourrait m'aider?

Mes meilleures salutations,

Thierry

Bonjour,
Essaye comme ceci

Sub BoutonInserer1LigneVide()
    ActiveSheet.Unprotect Password:="."
    Application.EnableEvents = False
    With ActiveCell
        .Offset(1, 0).EntireRow.Resize(1).Insert Shift:=xlDown
         Cells(6, 1).Copy: .Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
        .Offset(1, 0).RowHeight = Cells(6, 1).RowHeight
    End With
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="."
End Sub

 

[tchi456]

Bonjour Jacky67,

Merci pour votre code; il fonctionne bien malheureusement il ne copie pas la bordure et la couleur de la cellule en dessous de la cellule préalablement sélectionnée redevient blanche.

Meilleures salutations,

Thierry

 

[Jacky67]

Bonjour Jacky67,

Merci pour votre code; il fonctionne bien malheureusement il ne copie pas la bordure et la couleur de la cellule en dessous de la cellule préalablement sélectionnée redevient blanche; voir fichier.

Meilleures salutations,

Thierry

Re...
Il est demandé
soit toujours identique à la ligne 6
Or la ligne 6 est blanche et sans bordure

 

[tchi456]

Re bonjour Jacky,

Voici le fichier un peu plus complet pour une meilleure compréhension.
J'aimerais que toute la ligne soit copiée entièrement mais sans le contenu des cellules.

Meilleures salutations,
Thierry

 

[Jacky67]

Re bonjour Jacky,

Voici le fichier un peu plus complet pour une meilleure compréhension.
J'aimerais que toute la ligne soit copiée entièrement mais sans le contenu des cellules.

Meilleures salutations,
Thierry

Re..
Ok, essaye le classeur en pj

 

[tchi456]

Re bonjour Jacky,

Votre code fonctionne parfaitement bien.
J'ai ajouté un bouton supplémentaire pour pouvoir supprimer la ligne si erreur de manipulation:

Sub BoutonSupprimerLignes()
    ActiveSheet.Unprotect Password:="."
    If MsgBox("Voulez-vous supprimer ces lignes ? ", vbYesNo) = vbYes Then
    Selection.EntireRow.Delete
    End If
    ActiveSheet.Protect Password:="."
End Sub

Merci beaucoup pour votre aide et bon après-midi !

 

[tchi456]

J'ai encore une question en espérant ne pas abuser; j'ai les formules ci-dessous dans les cellules des colonnes L et S que je souhaite conserver et incrémenter à chaque insertion d'une nouvelle ligne identique à la ligne 9:

=SI(NB.VIDE(J7:L7);"";J7*K7*L7)
=SI(NB.VIDE(Q7:S7);"";Q7*R7*S7)

Comment puis-je adapter votre code qui fonctionne déjà super bien?

Sub BoutonInserer1LigneVideIdentiqueLigne9()
    If ActiveCell.Row < 9 Then Exit Sub
    ActiveSheet.Unprotect Password:="."
    Application.EnableEvents = False
    With ActiveCell
        .Offset(1).EntireRow.Insert
        Rows(9).Copy
        .Offset(1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        .Offset(1).RowHeight = Cells(9, 1).RowHeight
    End With
    Application.CutCopyMode = False
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="."
End Sub

Meilleures salutations,

Thierry

 

[Jacky67]

J'ai encore une question en espérant ne pas abuser; j'ai les formules ci-dessous dans les cellules des colonnes L et S que je souhaite conserver et incrémenter à chaque insertion d'une nouvelle ligne identique à la ligne 9:

=SI(NB.VIDE(J7:L7);"";J7*K7*L7)
=SI(NB.VIDE(Q7:S7);"";Q7*R7*S7)

Comment puis-je adapter votre code qui fonctionne déjà super bien?

Meilleures salutations,

Thierry

Re..

Sub BoutonInserer1LigneVideIdentiqueLigne7()
    If ActiveCell.Row < 6 Then Exit Sub
    ActiveSheet.Unprotect Password:="."
    Application.EnableEvents = False
    With ActiveCell
        .Offset(1).EntireRow.Insert
        Rows(7).Copy
        .Offset(1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        .Offset(1).RowHeight = Cells(7, 1).RowHeight
        Cells(7, "m").Copy Cells(.Row + 1, "m")
        Cells(7, "t").Copy Cells(.Row + 1, "t")
    End With
    Application.CutCopyMode = False
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="."
End Sub

 

[tchi456]

Re..

Sub BoutonInserer1LigneVideIdentiqueLigne7()
    If ActiveCell.Row < 6 Then Exit Sub
    ActiveSheet.Unprotect Password:="."
    Application.EnableEvents = False
    With ActiveCell
        .Offset(1).EntireRow.Insert
        Rows(7).Copy
        .Offset(1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        .Offset(1).RowHeight = Cells(7, 1).RowHeight
        Cells(7, "m").Copy Cells(.Row + 1, "m")
        Cells(7, "t").Copy Cells(.Row + 1, "t")
    End With
    Application.CutCopyMode = False
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="."
End Sub

Incroyable! C'est exactement ce qu'il me fallait !

Merci infiniment. Je vous souhaite une bonne fin de journée et vous adresse mes respectueuses salutations.

Thierry