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 SubVous 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 IfA+
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 SubRé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