Option Explicit Sub patternCouleur() Dim lig As Long, derlig As Long derlig = Cells(Rows.Count, 4).End(xlUp).Row For lig = 2 To derlig patternCouleurLig (lig) Next lig End Sub Sub patternCouleurLig(lig As Long) Dim s As String Dim R As Long, V As Long, B As Long R = CLng("&h" & Cells(lig, 2)) V = CLng("&h" & Cells(lig, 3)) B = CLng("&h" & Cells(lig, 4)) Application.EnableEvents = False Cells(lig, 8) = [Pattern] Cells(lig, 8).Resize(1, 2).Font.Color = RGB(R, V, B) Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim col As Long, w3c As String If Target.Count > 1 Then Exit Sub If Target.Row < 5 Or Target.Column > 4 Then Exit Sub Application.EnableEvents = False If Target.Column = 1 Then ' formatage saisie w3c w3c = Cells(Target.Row, 1) If Left(w3c, 1) = "#" Then w3c = Mid(w3c, 2) w3c = "#" & UCase(Right("000000" & w3c, 6)) ' maj cellules Cells(Target.Row, 1) = w3c Cells(Target.Row, 2) = Mid(w3c, 2, 2) Cells(Target.Row, 3) = Mid(w3c, 4, 2) Cells(Target.Row, 4) = Right(w3c, 2) Else ' colonnes B:D ' formatage saisie RVB Target = Right("00" & UCase(Target), 2) ' maj w3c For col = 2 To 4 w3c = w3c & Right("00" & Cells(Target.Row, col), 2) Next col Cells(Target.Row, 1) = "#" & w3c End If Application.EnableEvents = True patternCouleurLig (Target.Row) End Sub