SolverReset
On Error Resume Next
Dim Plage As Range
Dim Cel As Range
Set Plage = Range("B2:D16").Find("")
For Each Cel In Range("A1:D" & Range("D16").End(xlUp).Row)
If Cel.Interior.Color = "255" Then Set Plage = Union(Plage, Cel)
Next
SolverOK SetCell:=Range("J2"), MaxMinVal:=3, ValueOf:=0, ByChange:=Plage
SolverAdd CellRef:=Range("J2:J4,J6:J8"), Relation:=2, FormulaText:=0
SolverSolve UserFinish:=True