Détection modification de cellule et copie de contenu de cellule + username

Bonjour,

J'ai créée un classeur afin de suivre des opérations de production selon trois états (trois colonnes distinctes à compléter avec une croix via validation de données et mise en forme conditionnelle).
Je souhaiterais qu'en fonction du contenu de certaines cellules plage ("E14:E73")) -présence d'une "x" ou non-, effectuer une copie dans un onglet log de cette opération (toujours 3 colonnes avant) et y adjoindre le "username de l'utilisateur"


J'ai commencé avec ce code:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

Private Sub WorkSheet_Change(ByVal Target As Range)   If Not Intersect(Target, Range("E14:E73")) Is Nothing Then   Application.ScreenUpdating = False   If Target.Value = "x" Then   If MsgBox("Etes-vous certain(e) de ne pas effectuer cette opération ?", vbYesNo, "Demande de confirmation") = vbYes Then   Target.Offset(0, -3).Copy   With Sheets("Log") .Select   .Range("A65536").End(xlUp)(2).Select   ActiveSheet.Paste   .Range("A65536").End(xlUp)(3).Value = Environ("username")   End With   End If   Application.ScreenUpdating = True   End Sub

---

D'avance merci pour votre aide

Bonjour,

Tel quel, ta macro écrit la cellule de la colonne B et deux lignes en dessous, le nom d'utilisateur. Qu'est-ce que tu souhaites ?

Merci de me répondre.

Ce que je souhaite c'est que:
A chaque fois que l'utilisateur saisit une croix dans cette plage de cellule ("E14:E73") et qu'il confirme, automatiquement son username et l'activité de production (en colonne B:B) soit copier coller dans une autre feuille "Log"

Pour le moment ma macro ne fait rien du tout, la boîte de dialogue ne s'exécute même pas... je ne comprends pas

Je joins le fichier, ce sera plus clair.

En fait, il manquait deux "End If" à ta macro; tu dois la coller dans le module de la feuille :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

Private Sub WorkSheet_Change(ByVal Target As Range)   If Not Intersect(Target, Range("E14:E73")) Is Nothing Then   Application.ScreenUpdating = False   If Target.Value = "x" Then   If MsgBox("Etes-vous certain(e) de ne pas effectuer cette opération ?", vbYesNo, "Demande de confirmation") = vbYes Then   Target.Offset(0, -3).Copy   With Sheets("Log") .Select   .Range("A65536").End(xlUp)(2).Select   ActiveSheet.Paste   .Range("A65536").End(xlUp)(3).Value = Environ("username")   End With   End If End If End If   Application.ScreenUpdating = True   End Sub

---

D'accord merci

Le problème c'est que j'ai déjà mis cette macro dans la feuille (suivi Prod)
Mais elle ne s'execute toujours pas

Je me demande si le fait d'avoir déjà une autre macro WorkSheet_SelectionChange (pour gérer mes croix) ne l'empêche pas de s'executer ?

Merci

Regarde le classeur joint. J'ai mis un "x" en E36; regarde le résultat sur la feuille Log. J'ai enregistré le classeur au format "xls", mais ça ne change rien.

Citation:

---

Je me demande si le fait d'avoir déjà une autre macro WorkSheet_SelectionChange (pour gérer mes croix) ne l'empêche pas de s'executer ?

---

Non. Par contre, il faut entrer des "x" minuscules. Les majuscules ne la déclencheront pas, ou alors, il faut la changer.