Changer la couleur d'une cellule si cellule modifiée

Bonjour,

Apparemment plus de bug ... mais malgré changement de la valeur après activation de la macro, la cellule ne change pas de couleur.

Par contre, lorsque l'on modifie à la main la valeur PAFR01 là, la couleur de la cellule New PV Normal colonne O change ...

Peut-être une piste ...

Merci,

Loadlucas

re-bonjour,

Sub MAJPABOISSONS()
    Dim d As Object, k, n%, i%, j%, wbf$, clr&, Tpm()
    Application.EnableEvents = False
    Set d = CreateObject("Scripting.Dictionary")
    wbf = ActiveSheet.Range("AH1")
    With Workbooks(wbf).Worksheets(1)
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            If .Cells(i, 1) <> "" Then d(.Cells(i, 1).Value) = .Cells(i, 6)
        Next i
    End With
    If d.Count = 0 Then Exit Sub
    With ThisWorkbook.Worksheets("BOISSONS")
        n = .Cells(.Rows.Count, 4).End(xlUp).Row
        clr = RGB(191, 191, 191)
        Application.ScreenUpdating = False
        For i = 3 To n
            If .Cells(i, 4).Value <> "" Then .Cells(i, 22).Interior.Color = clr
        Next i
        clr = RGB(255, 192, 0)
        For i = 3 To n
            k = .Cells(i, 4)
            If d.exists(k) Then
                If CDbl(d(k)) <> .Cells(i, 22) Then
                    ov = .Cells(i, 15)
                    .Cells(i, 22) = CDbl(d(k))
                    .Cells(i, 22).Interior.Color = clr
                    If .Cells(i, 15) <> ov Then .Cells(i, 15).Interior.Color = vbRed Else .Cells(i, 15).Interior.Color = RGB(165, 165, 165)
                    j = j + 1: ReDim Preserve Tpm(2, j)
                    Tpm(0, j) = k: Tpm(1, j) = .Cells(i, 7): Tpm(2, j) = .Cells(i, 22)
                End If
            End If
        Next i
    End With
    If j = 0 Then Exit Sub
    Tpm(0, 0) = "CODE": Tpm(1, 0) = "Désignation": Tpm(2, 0) = "Prix modifié"
    With Worksheets("CHECK BOISSONS")
        .UsedRange.Clear
        With .Range("A1:C" & j + 1)
            .Value = WorksheetFunction.Transpose(Tpm)
            .Columns(1).HorizontalAlignment = xlCenter
            .Columns(2).AutoFit
            .Rows(1).HorizontalAlignment = xlCenter
            .Borders.Weight = xlThin
        End With
    End With
    Application.EnableEvents = True
End Sub

Bonjour,

Super !

ça a l'air de bien fonctionner !!! je test plus en profondeur et je clôture la sujet.

Encore un énorme merci !

Loadlucas