Dim K 'ne pas supprimer, déplacer
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, [B8:B15]) Is Nothing And R.Count = 1 Then K = R
End Sub
Private Sub Worksheet_Change(ByVal R As Range)
Dim C As Range
If Not Intersect(R, [B8:B15]) Is Nothing And R.Count = 1 Then
On Error Resume Next 'plage vide
Application.EnableEvents = 0
If R = "" And K <> "" Then
For Each C In [B8:B15].SpecialCells(2)
C = C.Value - 1
If C < 0 Then C = ""
K = ""
Next
End If
Application.EnableEvents = 1
End If
End Sub