Tu peux essayer un truc comme ça :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Interior.color <> 10921638 Then
If Not Intersect([F6:W64], Target) Is Nothing Then
Dim couleurs(), nbre(), couleur
couleurs = Array(RGB(255, 0, 0), RGB(255, 255, 0), RGB(51, 255, 0), RGB(0, 153, 51), RGB(255, 255, 255))
nbre = Array(, 10, 25, 40, 50)
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 5)
Target = nbre(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 5)
Cancel = True
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End If
End If
End Sub
A+