Historique Valeur Cellule - Evolution prix

Bonjour,

Voici la mise en situation :

Situation :

Nous avons des multiples fichiers Excel qui servent de feuilles de chiffrage afin d'établir les devis. Plusieurs personnes ont accès à ces feuilles de chiffrages et peuvent actualiser le prix matière. Nous souhaiterions incrémenter automatique dans le tableau "HISTORIQUE" du fichier test ci-joint, la date, le prix matière et l'auteur de la modification au dernier enregistrement. Cela nous permettrait de connaitre l'évolution du prix, quand et par qui il a été modifié. En pièce jointe un fichier pour exemple.

Exemple :

Le 01/01/2023, M. A change le prix matière acier de 5€ à 7€. Automatiquement lors de l'enregistrement, la date du 01/01/2023 se met dans la cellule B14, le prix matière "7€" dans la cellule B15, et les initiales ou nom "M. A" dans la case B16.

Le 01/02/2023, M. B change le prix matière acier de 7€ à 3€. Automatiquement lors de l'enregistrement, la date du 01/02/2023 se met dans la cellule C14, le prix matière "3€" dans la cellule C15, et les initiales ou nom "M. B" dans la case C16.

Etc

Merci d'avance pour votre retour,

Bonjour antoine50290,

A tester :

Bonjour à tous,

Une macro qui effectue quelques vérifications et demande quelques confirmations.

Le code est dans le module de la feuille "Feuil1" :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Avant, Apres, rep, nom, col&
   If Not Target.Address(0, 0) = "B6" Then Exit Sub
   On Error GoTo FIN
   Application.EnableEvents = False
   Apres = [b6]: Application.Undo: Avant = [b6]: [b6] = Apres
   If Target = "" Or Not IsNumeric(Target) Then
      [b6] = Avant
      MsgBox "La nouvelle valeur doit être un nombre"
      GoTo FIN
   Else
      Apres = Round(Apres, 2)
      rep = MsgBox("Remplacer l'ancienne valeur : " & Format(Avant, "0.00") & vbLf & vbLf & _
         "par la nouvelle valeur : " & Format(Apres, "0.00"), vbQuestion + vbYesNo + vbDefaultButton2)
      If rep <> vbYes Then
         [b6] = Avant
         MsgBox "La valeur reste inchangée à : " & Format(Avant, "0.00")
      Else
         Do While nom = ""
            nom = Application.InputBox("Veuillez saisir votre nom, svp.")
            If nom = False Then
               [b6] = Avant
               MsgBox "Pas de nom => Pas de changement !"
               GoTo FIN
            End If
         Loop
         [b6] = Apres
         col = Cells(14, Columns.Count).End(xlToLeft).Column + 1
         Cells(14, col).NumberFormat = "dd/mm/yyyy"
         Cells(14, col) = Date
         Cells(15, col) = Apres
         Cells(16, col) = nom
         MsgBox "La valeur est maintenant : " & Format(Apres, "0.00")
      End If
   End If

FIN:
   On Error GoTo 0
   Application.EnableEvents = True
End Sub