Suivi de modification en VBA

Bonjour

J'essaye non sans mal d'activer un suivi de modification en VBA.

Je souhaiterais qu'une ligne s'ajoute a mon tableau en feuille 3 "Logs" à chaque fois qu'une cellule est modifiée, en y renseignant

* La cellule modifiée (Ok)

* La valeur initiale

* La valeur modifiée (Ok)

* L'horodatage (Ok)

* L'utilisateur qui modifie (Ok)

En cherchant, j'ai réussi a faire ce code

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("Logs").ListObjects("_logs").ListRows.Add
.Range(1) = "Modification de la cellule " & Target.Address
.Range(3) = Target.Value
.Range(4) = Now
.Range(5) = Application.UserName
End With
End Sub

Malheureusement je n'arrive pas a trouver le Range(2) = Valeur initiale (donc la valeur de la cellule avant la modification)

Et j'aimerai appliquer cela a l'ensemble de mes feuilles et non à la feuille Candidats, est ce possible ?

Merci d'avance

Bonjour,
Une contribution, de mémoire VBA !?
Cdlt.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject, rCell As Range, oldValue, newValue
Const R As String = "A4:A32"

    On Error GoTo errHandler

    If Not Intersect(Target, Me.Range(R)) Is Nothing And Target.CountLarge = 1 Then
        Application.EnableEvents = False
        Set lo = Worksheets("Logs").ListObjects(1)
        With lo
            If .InsertRowRange Is Nothing Then
                Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
            Else
                Set rCell = .InsertRowRange.Cells(1)
            End If
        End With

        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue

        With rCell
            .Value = Target.Address
            .Offset(, 1).Value = oldValue
            .Offset(, 2).Value = newValue
            .Offset(, 3).Value = VBA.Now()
            .Offset(, 4).Value = Application.UserName
        End With
    End If

exitHandler:
    Application.EnableEvents = True
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler
End Sub

Hello

Merci à toi, j'arrive en copiant ton code à récupérer la valeur initiale mais est il possible d'appliquer cela a tout le document et de ne pas se limiter aux cellules .

A4:A32

Autre question

Maintenant quand je renseigne une cellule et que j'appuie sur Entrée, la cellule suivante en dessous n'est plus sélectionnée ?

Comment revenir à la normal, sachant que l'option avancé est malgré tout coché pour aller à la cellule vers le bas ?

Bonjour Jean-Eric

Ton code fonctionne parfaitement, mais il me reste un petit problème.

Lorsque je rentre une valeur sur la feuille candidats suivi par entrée, la cellule sélectionnée ne devient pas la suivante vers le bas mais reste sur la même cellule ce qui m'impose d'effectuer entrée deux fois de suite. J'ai cherché dans ton code le problème, et il semblerait que ça vienne de cette partie la.

        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue

J'ai essayé passablement de combinaisons mais je n'arrive pas a remplacer le Application.Undo qui pose à mon avis le pb.

Je remets ici le code complet pour plus de compréhension

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject, rCell As Range, oldValue, newValue
Const R As String = "A4:A32"

    On Error GoTo errHandler

    If Not Intersect(Target, Me.Range(R)) Is Nothing And Target.CountLarge = 1 Then
        Application.EnableEvents = False
        Set lo = Worksheets("Logs").ListObjects(1)
        With lo
            If .InsertRowRange Is Nothing Then
                Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
            Else
                Set rCell = .InsertRowRange.Cells(1)
            End If
        End With

        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue

        With rCell
            .Value = Target.Address
            .Offset(, 1).Value = oldValue
            .Offset(, 2).Value = newValue
            .Offset(, 3).Value = VBA.Now()
            .Offset(, 4).Value = Application.UserName
        End With
    End If

exitHandler:
    Application.EnableEvents = True
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler
End Sub

En espérant que quelqu'un me vienne en aide.

Merci d'avance

Hello

Je mets ici une solution si ça intéresse quelqu'un

        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue
        Cells(Target.Row + 1, Target.Column).Select