Colorié identiquemnt et automatiquement une cellule remplie de nombre en fct

Private Sub Worksheet_Change1(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("B72:F72")) Is Nothing Then
        Range("B72:F72").Copy Range("ND3:NH3")
    End If
    Application.EnableEvents = True
End Sub

Dim Shf1 As Worksheet, Shf2 As Worksheet
Dim DerCol_f2 As Long

Sub Couleurs_et_Valeurs()
    Application.ScreenUpdating = False
    Range("B72:F72").Copy Range("ND3:NH3")
    Range("MX10:MX62").ClearContents
    Range("MX10:MX62").FormatConditions.Delete
    For i = 2 To 6
        Set v = Range("MW10:MW62").Find(Cells(72, i), LookIn:=xlValues, lookat:=xlWhole)
        If Not v Is Nothing Then
            Cells(72, i).Copy Cells(v.Row, "MX")
        End If
    Next i
End Sub

Sub Sauvegarde()
    Application.ScreenUpdating = False
    Set Shf1 = Sheets("Feuil1")
    Set Shf2 = Sheets("Feuil2")
    DerCol_f2 = Shf2.[XFD1].End(xlToLeft).Column + 1
    Shf1.Range("MX10:MX62").Copy Shf2.Cells(2, DerCol_f2)
    Shf2.Cells(1, DerCol_f2) = Date
    RecupCouleur
    Shf2.Select
End Sub

Sub RecupCouleur()
    Dim FC As FormatCondition, F1 As Variant
    Dim C As Range
    
    Shf1.Select
    For i = 10 To 62
        Set C = Cells.Find(Empty)
        For Each FC In Shf1.Cells(i, "MX").FormatConditions
            C.FormulaLocal = FC.Formula1: F1 = C
            F1 = C
            If F1 Then Exit For
        Next FC
        If Not FC Is Nothing Then Couleur = FC.Interior.Color Else: Couleur = Shf1.Cells(i, "MX").Interior.Color
        Shf2.Cells(i - 8, DerCol_f2).Interior.Color = Couleur
        C.Clear
    Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("ND3:NH3")) Is Nothing Then
        Range("ND3:NH3").Copy Range("B72:F72")
    End If
    Application.EnableEvents = True
End Sub

Sub Couleurs_et_Valeurs()
    Application.ScreenUpdating = False
    Range("B72:F72").Copy Range("ND3:NH3")
    Range("MX10:MX62").ClearContents
    Range("MX10:MX62").FormatConditions.Delete
    For i = 2 To 6
        Set v = Range("MW10:MW62").Find(Cells(72, i), LookIn:=xlValues, lookat:=xlWhole)
        If Not v Is Nothing Then
            Cells(72, i).Copy Cells(v.Row, "MX")
        End If
    Next i
End Sub