XL 2016 Macro insérer 2 lignes copiées dans un tableau

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

SMEAGOAL

XLDnaute Junior
Bonjour à tous,
J'ai essayé d'adapter une macro sur mon fichier mais ça ne fonctionne pas...
La macro modèle s'appelle module 11 et m'avait été envoyée par job75,
Je voudrais que la mienne copie les lignes 122&123 et les insère dans le tableau au dessus de la cellule sélectionnée (B146 dans l'exemple),
Est-ce que vous pourriez m'aider là-dessus?
Merci.
 

Pièces jointes

Solution
fanch55
Remplacez le code de la feuille par :
VB: 
Option Compare Text
Dim CopyGroup  As Boolean
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Select Case True
        Case Target.Count <> 2                                  ' Il faut 2 cellules
        Case Target.Rows.Count <> 2                             ' sur 2 lignes
        Case Not Target.MergeCells                              ' Elles doivent être fusionnées
        Case Not Target.Column = 4                              ' en colonne 4
        Case Not Target.Cells(1).HasFormula                     ' il faut une formule
        Case Not Target.Cells(1).FormulaLocal Like "*decaler*"  ' de type "décaler"
        Case Else
            Cancel = True...
Trier par date Trier par votes
Bonsoir, je ne comprend pas,
le menu spécial ne s'affiche que si on clique droit sur une cellule fusionnée sur 2 lignes en colonne 4 et ayant une formule "Décaler".. les options de "copier groupe" et "insérer groupe" sont en sus de ce qui existe dans le menu normal. Pourriez-vous me fournir le classeur sur lequel vous avez le problème ?
 
Vote positif 0 Vote négatif
Remplacez le code de la feuille par :
VB: 
Option Compare Text
Dim CopyGroup  As Boolean
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Select Case True
        Case Target.Count <> 2                                  ' Il faut 2 cellules
        Case Target.Rows.Count <> 2                             ' sur 2 lignes
        Case Not Target.MergeCells                              ' Elles doivent être fusionnées
        Case Not Target.Column = 4                              ' en colonne 4
        Case Not Target.Cells(1).HasFormula                     ' il faut une formule
        Case Not Target.Cells(1).FormulaLocal Like "*decaler*"  ' de type "décaler"
        Case Else
            Cancel = True   ' on empêche Excel d'afficher le menu normal
           ' et on ajoute ses propres options au Menu Clic_Droit de la cellule
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .Caption = "copier ce groupe "
                    .FaceId = 19
                    .OnAction = Me.CodeName & ".Copier_Groupe"
                End With
                With .Controls.Add(msoControlButton, 1, , 2, True)
                    .Caption = "Insérer le groupe copié"
                    .Enabled = CopyGroup
                    .FaceId = 4173
                    .OnAction = Me.CodeName & ".Insérer_Groupe"
                End With
                With .Controls.Add(msoControlButton, 1, , 3, True)
                     ' Ligne blanche
                End With
                .ShowPopup                                      ' on affiche le menu
                For Each Control In .Controls
                    If Not Control.BuiltIn Then Control.Delete  ' On détruit les éléments ajoutés
                Next
            End With
    End Select
End Sub
Sub Copier_Groupe()
    Selection.EntireRow.Copy ' On copie les 2 lignes entières du Groupe
    CopyGroup = True         ' On indique qu'une copie de groupe est en cours
End Sub
Sub Insérer_Groupe()
    Selection.EntireRow.Insert Shift:=xlDown ' On insère le groupe copié
    Copier_Groupe                            ' On recharge le presse-papier
                                             ' pour pouvoir continuer à Insérer si besoin
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 4 Then
        If CopyGroup Then
            Application.CutCopyMode = False
            CopyGroup = False
        End If
    End If
End Sub
 
Vote positif 0 Vote négatif
Solution
fanch55 à dit:
Remplacez le code de la feuille par :
VB: 
Option Compare Text
Dim CopyGroup  As Boolean
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Select Case True
        Case Target.Count <> 2                                  ' Il faut 2 cellules
        Case Target.Rows.Count <> 2                             ' sur 2 lignes
        Case Not Target.MergeCells                              ' Elles doivent être fusionnées
        Case Not Target.Column = 4                              ' en colonne 4
        Case Not Target.Cells(1).HasFormula                     ' il faut une formule
        Case Not Target.Cells(1).FormulaLocal Like "*decaler*"  ' de type "décaler"
        Case Else
            Cancel = True   ' on empêche Excel d'afficher le menu normal
           ' et on ajoute ses propres options au Menu Clic_Droit de la cellule
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .Caption = "copier ce groupe "
                    .FaceId = 19
                    .OnAction = Me.CodeName & ".Copier_Groupe"
                End With
                With .Controls.Add(msoControlButton, 1, , 2, True)
                    .Caption = "Insérer le groupe copié"
                    .Enabled = CopyGroup
                    .FaceId = 4173
                    .OnAction = Me.CodeName & ".Insérer_Groupe"
                End With
                With .Controls.Add(msoControlButton, 1, , 3, True)
                     ' Ligne blanche
                End With
                .ShowPopup                                      ' on affiche le menu
                For Each Control In .Controls
                    If Not Control.BuiltIn Then Control.Delete  ' On détruit les éléments ajoutés
                Next
            End With
    End Select
End Sub
Sub Copier_Groupe()
    Selection.EntireRow.Copy ' On copie les 2 lignes entières du Groupe
    CopyGroup = True         ' On indique qu'une copie de groupe est en cours
End Sub
Sub Insérer_Groupe()
    Selection.EntireRow.Insert Shift:=xlDown ' On insère le groupe copié
    Copier_Groupe                            ' On recharge le presse-papier
                                             ' pour pouvoir continuer à Insérer si besoin
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 4 Then
        If CopyGroup Then
            Application.CutCopyMode = False
            CopyGroup = False
        End If
    End If
End Sub
Cliquez pour agrandir...
Ca fonctionne!
Merci fanch55!
A+!
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
Microsoft 365 Copie VBA d'un tableau présent et identique sur 12 onglets dans un autre onglet dont seules les lignes complétées sont copiées
Réponses
4
Affichages
663
AlexiaC
A
F
  • Résolu(e)
Microsoft 365 Macro pour copier des lignes et les coller à l'emplacement de la cellule sélectionnée
Réponses
2
Affichages
1 K
Fanou44
F
D
  • Question Question
Vba macro pour créer un tableau croisé dynamique avec lignes variables
Réponses
1
Affichages
2 K
soan
S
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
2 K
Kushi
K
A
  • Question Question
XL 2013 Insérer lignes et liens dans plusieurs tableaux successifs (macros)
Réponses
0
Affichages
681
Arkana54
A
J
  • Question Question
Excel -VBA : Envoie plusieurs partie du même tableau dans un corps mail en fonction de certaines conditions
Réponses
0
Affichages
2 K
JBIK
J
M
  • Résolu(e)
Microsoft 365 Insérer 2 lignes en copiant certaines cellules
Réponses
4
Affichages
1 K
haonv
H
S
  • Question Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
7 K
Scorp0211
S
escouger
  • Résolu(e)
XL 2013 Copier une feuille dans un nouveau tableau avec une macro VBA
Réponses
1
Affichages
920
Dudu2
Dudu2
B
  • Résolu(e)
XL 2013 Macro pour ajouter des données dans un tableau
Réponses
11
Affichages
6 K
Dranreb
Dranreb
benoitoleron
  • Résolu(e)
Microsoft 365 Remplacer une valeur saisie après recherche dans une liste sur un autre onglet
Réponses
4
Affichages
2 K
benoitoleron
benoitoleron
J
  • Question Question
Microsoft 365 Extraction dans un tableau de lignes marquées et de colonnes marquées
Réponses
0
Affichages
507
Jeh
J
F
  • Question Question
re-Modification à partir d'une ComboBox dans un tableau dynamique
Réponses
9
Affichages
4 K
Staple1600
Staple1600
D
  • Question Question
VBA : Insérer fonction SI complexe dans macro
Réponses
5
Affichages
1 K
Dimebag
D
K
  • Question Question
XL 2010 insertion dans un tableau par inputbox
Réponses
4
Affichages
2 K
korobo
K
A
  • Question Question
Macro - Transférer un tableau sur une autre feuille
Réponses
0
Affichages
672
allix5
A
M
  • Question Question
Comparer 2 listes avec une macro
Réponses
6
Affichages
2 K
Maryloo2005
M
M
  • Question Question
copier tableau feuil1 et collage dans feuil2 avec decalage de 2 lignes a chaque opéra
Réponses
6
Affichages
2 K
manfredi973
M
P
  • Question Question
choisir un fichier dans une macro qui change de nom et d'emplacement à chaque fois
Réponses
2
Affichages
1 K
mutzik
mutzik
Z
  • Question Question
Macro d'envoi automatique d'éléments dans un tableau de synthèse
Réponses
0
Affichages
766
Zoub
Z
Retour