XL 2019 Cocher une case en décoche une autre et inversement

[Dravol]

Bonjour à tous,

Dans la macro ci-dessous lorsque je coche H18 je voudrais que J18 soit décoché (et inversement)

D'ailleurs j'aimerais apporter les mêmes fonctionnalités pour Q,R,S

Avez-vous la soluce ?^^

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, Z$, plage
If Target.Count = 1 Then
Z = Target.Value
plage = "h18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
[j18] = IIf(Z = "", "ü", "")
End If
plage = "j18"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q24:Q43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R24:R43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S24:S43"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "Q45:Q48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "R45:R48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
plage = "S45:S48"
Set isect = Application.Intersect(Target, Range(plage))
If Not isect Is Nothing Then
Target.Value = IIf(Z = "", "ü", "")
End If
End If

'If Target.Address = Range("d19").Address And Range("d19").Value > 10 Then
If Target.Address = Range("d19").MergeArea.Address And Range("d19").Value > 10 Then
Dim I
For I = 1 To 3 ' Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next
End If

End Sub

 

[job75]

Bonjour Dravol,

   plage = "h18"
   Set isect = Application.Intersect(Target, Range(plage))
   If Not isect Is Nothing Then
      Target = IIf(Z = "", "ü", "")
      Range("j18") = IIf(Target = "", "ü", "")
   End If
   plage = "j18"
   Set isect = Application.Intersect(Target, Range(plage))
   If Not isect Is Nothing Then
      Target = IIf(Z = "", "ü", "")
      Range("h18") = IIf(Target = "", "ü", "")
   End If

A+

 

[Dravol]

Merci job75

Nickel !
A+