Assemblage de deux macros

Bonjour,

J'essaie en vain d'assembler deux codes préalablement séparés sur 2 onglets distincts.

Je souhaiterais que les deux codes puissent agir sur le même onglet.

J'ai tenté avec if/elseif et goto, mais je n'y arrive pas, seule la première partie du code est prise en compte.

Pourriez-vous m'aider ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Range("M:M")) Is Nothing Then Exit Sub
    ActiveCell.Offset(0, -12).Copy
    For Each sh In Worksheets
        If sh.Name = "Recherche Occurrence" Then
            Cancel = True
            sh.Activate
        End If
    Next
    ActiveSheet.Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    If Intersect(Target, Range("N:N")) Is Nothing Then Exit Sub
    ActiveCell.Offset(0, -9).Copy
    For Each sh In Worksheets
        If sh.Name = "Recherche Occurrence" Then
            Cancel = True
            sh.Activate
        End If
    Next
    ActiveSheet.Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

End Sub

Vous pouvez récupérer le fichier à cette adresse : https://drive.google.com/file/d/1ONRFBxKEnAkgDx0XMz3BLBEulFdRmIzA/view?usp=sharing

Actuellement, sur le premier onglet, lorsque vous double-cliquer sur un chiffre de la colonne M, le code copie une cellule du tableau et va la coller sur un autre onglet.

Je souhaiterais pouvoir faire la même chose avec la colonne N en plus, et coller la cellule à un autre endroit.

D'avance, merci pour votre aide.

Bonne journée à tous.

Bonjour,

pour pouvoir travailler sur les colonne M et N dans la même sub, il faut modifier le test de intersect

    If Not Intersect(Target, Range("M:M")) Is Nothing Then 
      ' Traitement si col M
       .../...
  End If

    If Not Intersect(Target, Range("N:N")) Is Nothing Then 
      ' Traitement si col N
       .../...
  End If

A+

Bonjour et bienvenue sur le forum

Essaie comme ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Range("M:M")) Is Nothing Then
        ActiveCell.Offset(0, -12).Copy
        For Each sh In Worksheets
            If sh.Name = "Recherche Occurrence" Then
                Cancel = True
                sh.Activate
            End If
        Next
        ActiveSheet.Range("C2").Select
        Selection.PasteSpecial Paste:=xlPasteValues
    ElseIf not Intersect(Target, Range("N:N")) Is Nothing Then 
        ActiveCell.Offset(0, -9).Copy
        For Each sh In Worksheets
            If sh.Name = "Recherche Occurrence" Then
                Cancel = True
                sh.Activate
            End If
        Next
        ActiveSheet.Range("K2").Select
        Selection.PasteSpecial Paste:=xlPasteValues
    End If
End Sub

Résultat ?

Bye !

Bonjour Messieurs,

Merci beaucoup pour vos réponses, en particulier pour la solution de @gmb

Ça fonctionne parfaitement bien. Un gros merci à vous.

A bientôt.

Pierre

Rechercher des sujets similaires à "assemblage deux macros"