Mettre plusieurs macros sur un même onglet
Bonjour,
Je voudrais utiliser 2 macros distinctes pour un même onglet mais j'ai le message suivant: Nom ambigu detecté : Worksheet_change
Macro 1 :
Option Explicit
Dim fd As Worksheet, cel As Range
Dim col&
Private Sub Worksheet_Change(ByVal Target As Range)
'Basculeur
If Target.Address = "$C$6" Then
Application.EnableEvents = False
Set fd = Sheets("Extraction Navision")
Sheets("Prog").Range("A3:A50").ClearContents
'Effacement de la colonne avec les cellules cochées
Range("A3:A50").ClearContents
'Range ("indique ou seront ramener les données pour effacer les anciennes"
On Error GoTo fin
col = fd.Range("L3:ww3").Find(What:=Target).Column
'col = fd.Range("plage de recherche du texte de la liste déroulante")
'col = fd.Range("POSSIBLE DE METTRE UN NOM DE TABLEAU")
For Each cel In fd.Range(fd.Cells(4, col), fd.Cells(3000, col))
'indique les lignes ou seront cherchés les données
If cel.Value <> "" And fd.Cells(cel.Row, 4) = "Basculeur" Then
Sheets("Prog").Range("A65000").End(xlUp).Offset(1, 0).Value = fd.Cells(cel.Row, 1)
'Range ("La lettre indique la colonne ou seront ramenés les données")
'df.cells(cel.Row, indique la colonne ou seront prise les données)
End If
Next cel
End If
fin:
Application.EnableEvents = True
End Sub
Sub evenement()
Application.EnableEvents = True
End Sub
Macro 2
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([B2:B20], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, Application.Index([Data], , 1), 0)
If Not IsError(p) Then Sheets("Extraction Navision").Range("data").Cells(p, 5).Copy Target.Offset(, 4)
End If
End Sub
Private Sub Worksheet_Activate() ' pour maj si changement dans la BD
Application.ScreenUpdating = False
For Each c In [B2:B20]
p = Application.Match(c, Application.Index([Data], , 1), 0)
If Not IsError(p) Then Sheets("Extraction Navision").Range("data").Cells(p, 5).Copy c.Offset(, 4)
Next c
Application.ScreenUpdating = True
End Sub
Pouvez-vous m'aider pour mettre ces 2 macros sur un onglet ?
Merci par avance,
David
Bonsoir,
Tu ne peux utiliser : Worksheet_change qu'une seule fois, il faut regrouper l'ensemble de ton code sous le sub worksheet_change.
Les sub peuvent être appelés dans le reste de la procédure, si on l'appelle par son nom mais que deux répondent, ça fonctionne pas, pour éviter ça Excel vérifie avant que les noms soient différents.
Bonne soirée !
Bonjour le fil,
En suivant ce qu'à dit Le Drosophile
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fd As Worksheet
Dim Cel As Range
Dim Col As Long, P as Long
'
If Not Intersect([B2:B20], Target) Is Nothing And Target.Count = 1 Then
P = Application.Match(Target, Application.Index([Data], , 1), 0)
If Not IsError(P) Then
Sheets("Extraction Navision").Range("data").Cells(P, 5).Copy Target.Offset(, 4)
End If
End If
'Basculeur
If Target.Address = "$C$6" Then
Application.EnableEvents = False
Set fd = Sheets("Extraction Navision")
Sheets("Prog").Range("A3:A50").ClearContents
'Effacement de la colonne avec les cellules cochées
Range("A3:A50").ClearContents
'Range ("indique ou seront ramener les données pour effacer les anciennes"
On Error GoTo fin
Col = fd.Range("L3:ww3").Find(What:=Target).Column
'col = fd.Range("plage de recherche du texte de la liste déroulante")
'col = fd.Range("POSSIBLE DE METTRE UN NOM DE TABLEAU")
For Each Cel In fd.Range(fd.Cells(4, Col), fd.Cells(3000, Col))
'indique les lignes ou seront cherchés les données
If Cel.Value <> "" And fd.Cells(Cel.Row, 4) = "Basculeur" Then
Sheets("Prog").Range("A65000").End(xlUp).Offset(1, 0).Value = fd.Cells(Cel.Row, 1)
'Range ("La lettre indique la colonne ou seront ramenés les données")
'df.cells(cel.Row, indique la colonne ou seront prise les données)
End If
Next Cel
End If
fin:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Activate() ' pour maj si changement dans la BD
Dim C As Range, P As Range
Application.ScreenUpdating = False
For Each C In [B2:B20]
P = Application.Match(C, Application.Index([Data], , 1), 0)
If Not IsError(P) Then Sheets("Extraction Navision").Range("data").Cells(P, 5).Copy C.Offset(, 4)
Next C
Application.ScreenUpdating = True
End Sub
@+
Bonjour,
@BrunoM45,
dim P as range ?
Cdlt.
Bonjour,
Pour être plus clair dans mon explication, j'ai créé un fichier exemple (en pièce jointe) avec la macro que j'ai déjà et dans lequel je voudrais ajouter la macro suivante :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([B2:B20], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, Application.Index([Data], , 1), 0)
If Not IsError(p) Then Sheets("Extraction Navision").Range("data").Cells(p, 5).Copy Target.Offset(, 4)
End If
End Sub
Private Sub Worksheet_Activate() ' pour maj si changement dans la BD
Application.ScreenUpdating = False
For Each c In [B2:B20]
p = Application.Match(c, Application.Index([Data], , 1), 0)
If Not IsError(p) Then Sheets("Extraction Navision").Range("data").Cells(p, 5).Copy c.Offset(, 4)
Next c
Application.ScreenUpdating = True
End Sub
Le but de cette macro est de copier les commentaires depuis l'onglet "Extraction Navision" colonne "E" vers l'onglet "Configurateur" colonne "D".
J'espère que vous pourrez m' aider rapidement... Je suis très embêté.
Merci par avance,
David
Bonjour à tous,
Quelqu'un pourrait-il m'aider s'il vous plaît ? Je n'y arrive vraiment malgré mon acharnement...
David
Bonjour David17340 et merci pour le fichier
Merci à Jean-Eric que je salue pour avoir mis le doigt sur une erreur
Ensuite, pour reprendre les codes, tu veux insérer ce code dans la feuille "Configurateur", ce code test la saisie dans la plage B2:B20 !
Or ces cellules ne correspondent à rien dans ton exemple
J'ai donc adapté le code à ton fichier test
Re,
Je pense que tu veux rire... mais perso, je ne trouve pas ca drôle
1) Tu ne veux pas faire d'effort de compréhension, je n'en ferais pas non plus
2) Tu n'as pas copier/coller le code comme il faut
C'est bon pour moi, au tour du suivant
Bonjour BrunoM45,
Je suis vraiment désolé parce que je me suis emmêlé les pinceaux entre différents fichiers, toutes mes excuses. Je serai plus vigilant à l'avenir. j'étais fatigué hier soir après avoir chercher la solution toute la journée.
Je m'y suis remis ce matin et effectivement la macro fonctionne. J'y ai apporté une modification pour supprimer les commentaires avant d'en afficher de nouveaux dans l'onglet '"configurateur", colonne D.
En revanche, je n'arrive pas à déclencher le rapatriement des commentaires en automatique dans devoir cliquer et valider dans les cellules de la colonne B (B12 et B13 par exemple).
Je voudrais qu'à partir du moment je sélectionne une donnée dans C7, que les commentaires s'affichent automatiquement dans la colonne D.
Pouvez-vous m'aider ?
Pouvez-vous m'expliquer également comment fonctionne cette partie de code ? Malgré de nombreuses recherches, je n'ai pas trouvé.
P = Application.Match(Target, Application.Index([Data], , 1), 0)
If Not IsError(P) Then Sheets("Extraction Navision").Range("data").Cells(P, 5).Copy Target.Offset(, 2)
Voici le fichier que j'ai modifié ce matin.
Encore toutes mes excuses,
Merci par avance,
David
Bonjour David17340
Je suis vraiment désolé parce que je me suis emmêlé les pinceaux entre différents fichiers, toutes mes excuses. Je serai plus vigilant à l'avenir. j'étais fatigué hier soir après avoir chercher la solution toute la journée.
Il faut parfois savoir s'arrêter pour prendre du recul
Je m'y suis remis ce matin et effectivement la macro fonctionne. J'y ai apporté une modification pour supprimer les commentaires avant d'en afficher de nouveaux dans l'onglet '"configurateur", colonne D.
En revanche, je n'arrive pas à déclencher le rapatriement des commentaires en automatique dans devoir cliquer et valider dans les cellules de la colonne B (B12 et B13 par exemple).
Je voudrais qu'à partir du moment je sélectionne une donnée dans C7, que les commentaires s'affichent automatiquement dans la colonne D.
Pouvez-vous m'aider ?
Désolé, mais il faut apprendre les bases des événements sur VBA
Pouvez-vous m'expliquer également comment fonctionne cette partie de code ? Malgré de nombreuses recherches, je n'ai pas trouvé.
P = Application.Match(Target, Application.Index([Data], , 1), 0) If Not IsError(P) Then Sheets("Extraction Navision").Range("data").Cells(P, 5).Copy Target.Offset(, 2)
Voici le fichier que j'ai modifié ce matin.
Alors on recherche la valeur de la cellule modifiée "Target" dans la plage nommée "Data"
P = Application.Match(Target, Application.Index([Data], , 1), 0)
Si il n'y a pas d'erreur (numéro de ligne trouvée) alors on copie la value de la feuille "Extraction Navision", Plage "Data", cellule (Ligne trouvée, 5ème colonne)
@+
Merci BrunoM45 pour ces réponses.
Je vais effectivement apprendre VBA mais cela va me prendre du temps et j'ai besoin d'appliquer la modification pour déclencher la copie de commentaire en automatique rapidement.
Je pense que pour vous si je ne me trompe pas, ça peut être très rapide. Pouvez-vous m'aider afin de clôturer ce sujet ?
merci par avance,
David
Re,
Sauf que je ne comprends absolument plus du tout ce que tu veux
Un coup tu parles de la modification dans [B2:B20] et maintenant dans C7
Quand tu sauras rassembler tes idées et t'exprimer clairement, je verrais !
Mais je ne suis pas le seul dans ce forum
BrunoM45, Je suis déçu par votre dernier message parce qu' il est clair que j'ai fait une erreur de fichier hier mais, selon moi, mon message posté à 10h38 est clair. Je pense m'exprimer clairement. Il y a un fichier joint et une image pour indiquer ce que je veux faire.
Je veux simplement déclencher la macro qui copie les commentaires en changeant la valeur de "C7" dans l'onglet "configurateur". Sauf que je n'y arrive pas.
David