Exclure une cellule d'une plage de cellules

Salut les amis, je viens vers vous pour vous demander aide et conseil.

J'ai deux plages de cellules :

Dim Plage1, Plage2 as Range
Set Plage1 = Range("D5, D9, D11, D15, D18, E6, E8, E11, E13, E18")

Si je sélectionne une cellule de la Plage1 (par exemple D15), la Plage2 doit devenir :

Plage2 = Plage1 – ActiveCell.Address, donc :

Plage2 = Range("D5, D9, D11, D18, E6, E8, E11, E13, E18")

La cellule active (sélectionnée) doit être exclue de la Plage1.

Je vous remercie d'avance pour votre aide.

Bonsoir Kraster, bonsoir le forum,

Essaie avec l'événementielle SelectionChange ci-dessous :

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'à la sélection dans l'onglet
Dim Plage1, Plage2 As Range, CEL As Range 'déclare les variables Plage1, Plage2 et CEL

Set Plage1 = Range("D5, D9, D11, D15, D18, E6, E8, E11, E13, E18") 'définit la plage Plage1
Plage1.Interior.ColorIndex = 4 'colore la plage Plage1 de vert (ligne à supprimer après les tests)
If Not Application.Intersect(Target, Plage1) Is Nothing Then 'condition : si la celluile sélectionnée se trouve dans la plage PLage1
    For Each CEL In Plage1 'boucle sur toutes les cellules CEL de Plage1
        If CEL.Address <> ActiveCell.Address Then 'condition 2 : si CEL n'est pas la cellule active
            'si la plage Plage 2 n'est pas encore définie, alors Plage2 devient CEL, sinon Plage2 devient l'intersection de de Plage2 et de CEL
            If Plage2 Is Nothing Then Set Plage2 = CEL Else Set Plage2 = Application.Union(CEL, Plage2)
        End If 'fin de la condition 2
    Next CEL 'prochaine cellule de la boucle
End If 'fin de la condition 1
If Not Plage2 Is Nothing Then Plage2.Interior.ColorIndex = 3 'colore Plage2 de rouge (ligne à supprimer après les tests)
End Sub

Un petit fichier exemple. Clique dans une cellule verte, Plage2 en rouge. Clique ailleurs, Plage1 en vert...

Bonjour,

Une proposition via ma fonction personnalisée "Minus"

Sub test()
    Dim Plage1 As Range, Plage2 As Range

    Set Plage1 = Range("D5, D9, D11, D15, D18, E6, E8, E11, E13, E18")
    Set Plage2 = Minus(Plage1, ActiveCell)
End Sub

Function Minus(ByVal A As Range, ByVal B As Range) As Range  'Plage A moins Plage B   
    Dim plage As Range, cell As Range

    Set Minus = Nothing
    For Each plage In A.Areas
        For Each cell In plage
            If Intersect(cell, B) Is Nothing Then
                If Minus Is Nothing Then Set Minus = cell _
                Else Set Minus = Union(Minus, cell)
            End If
        Next cell
    Next plage

End Function

:

Bonjour ThauThème, thev,

Je vous remercie infiniment pour vos réponses, ça m’a beaucoup aidé. C’est très gentil de vos parts.

Les deux solutions sont correctes, les deux m'ont servi (^_^).

Très bon week-end et merci encore.