Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

T

tchi456

XLDnaute Occasionnel
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
 
Solution
Re..


Code: 
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 =...
Trier par date Trier par votes

Jacky67

XLDnaute Barbatruc
Bonjour,
Essaye comme ceci
VB: 
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
 
Vote positif 0 Vote négatif
T

tchi456

XLDnaute Occasionnel
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
 
Dernière édition:
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
Re...
Il est demandé
soit toujours identique à la ligne 6
Or la ligne 6 est blanche et sans bordure
 
Vote positif 0 Vote négatif
T

tchi456

XLDnaute Occasionnel
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
 

Pièces jointes

  • Test.xlsm
    23.5 KB · Affichages: 4
Vote positif 0 Vote négatif
T

tchi456

XLDnaute Occasionnel
Re bonjour Jacky,

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

VB: 
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 !
 
Vote positif 0 Vote négatif
T

tchi456

XLDnaute Occasionnel
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?

VB: 
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
 

Pièces jointes

  • Test (2).xlsm
    22.1 KB · Affichages: 1
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
Re..


Code: 
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
 

Pièces jointes

  • Test V2.xlsm
    22.2 KB · Affichages: 3
Vote positif 0 Vote négatif
Solution
T

tchi456

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

F
  • Résolu(e)
Microsoft 365 VBA pour copier et insérer une ligne en dessous
Réponses
5
Affichages
395
Phil69970
T
  • Question
XL 2010 VBA - Bouton mettre en rouge plusieurs cellules sur la ligne de la cellule sélectionnée
Réponses
11
Affichages
585
job75
T
  • Résolu(e)
XL 2010 VBA - Insérer date et heures+minutes actuelle par double clics
Réponses
4
Affichages
773
Efgé
T
  • Résolu(e)
XL 2010 VBA - Insérer des lignes avec la même mise en forme que la ligne du dessus
Réponses
3
Affichages
503
Titi456
T
T
  • Résolu(e)
XL 2010 VBA - Annuler l'opération (Ctrl+Z)
Réponses
2
Affichages
1 K
tchi456
T
D
  • Question
XL 2010 Macros insérer une ligne en recopiant formule dans plusieurs feuilles
Réponses
11
Affichages
820
deva
D
T
  • Résolu(e)
XL 2010 VBA - Bouton retrait gauche du texte
Réponses
3
Affichages
650
tchi456
T
S
  • Question
Microsoft 365 Macro pour insérer une ligne avec conservation de formules et MFC
Réponses
3
Affichages
728
sanae_J
S
T
  • Question
XL 2010 VBA - Insérer une date rapidement (6, 7 ou 8 chiffres sans ".")
Réponses
4
Affichages
1 K
job75
  • Question
Microsoft 365 Recherche Find : impossible dans lignes masquées par le filtre
2 3
Réponses
38
Affichages
3 K
Usine à gaz
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…