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

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

  • Insérer lignes copiées.xlsm
    109.1 KB · Affichages: 6
Solution
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...

fanch55

XLDnaute Barbatruc
Bonjour,
J'ai remplacé vos formules en colonne D par =DECALER($D....;-2;0)+1
Les anciennes formules étaient incompatibles avec le coller dans votre cas .
Le copier/coller se fait par clic droit sur une cellule de la colonne D .
Tout le code se trouve dans celui de la feuille "EAU"
 

Pièces jointes

  • Insérer lignes copiées.xlsm
    119.7 KB · Affichages: 3

fanch55

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

fanch55

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

SMEAGOAL

XLDnaute Junior
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
Ca fonctionne!
Merci fanch55!
A+!
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 852
dernier inscrit
dthi16088