Plage

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set champ = Range("B1:D20,J2:O9,M12:R17")     'ou Range("laZone") si zone nommée
  '--------------- restitution couleurs
  For Each n In ActiveWorkbook.Names
   If n.Name = "mémoNcol" Then trouvé = True
  Next n
  If trouvé Then
   ncol = [mémoNCol]
   z = [mémozone]
   col1 = champ.Areas(z).Column
   col2 = champ.Areas(z).Column + champ.Areas(z).Columns.Count - 1
   For i = 1 To ncol
     x = "mémoAdresse" & i
     a = Evaluate([x])
     x = "mémoCouleur" & i
     b = Evaluate([x])
     Range(a).Interior.ColorIndex = b
   Next i
  End If
  '------------ mémorisation des couleurs
  If Not Intersect(champ, Target) Is Nothing And Target.Count = 1 Then
    For i = 1 To champ.Areas.Count
     If Not Intersect(champ.Areas(i), Target) Is Nothing Then zone = i
    Next i
    col1 = champ.Areas(zone).Column
    col2 = champ.Areas(zone).Column + champ.Areas(zone).Columns.Count - 1
    ActiveWorkbook.Names.Add Name:="mémoZone", RefersToR1C1:="=" & Chr(34) & zone & Chr(34)
    col1 = champ.Areas(zone).Column
    col2 = champ.Areas(zone).Column + champ.Areas(zone).Columns.Count - 1
    ncol = col2 - col1 + 1
    ActiveWorkbook.Names.Add Name:="mémoNcol", RefersToR1C1:="=" & Chr(34) & ncol & Chr(34)
    For i = 1 To ncol
      ActiveWorkbook.Names.Add Name:="mémoAdresse" & i, RefersToR1C1:= _
        "=" & Chr(34) & Cells(Target.Row, i + col1 - 1).Address & Chr(34)
      ActiveWorkbook.Names.Add Name:="mémoCouleur" & i, RefersToR1C1:= _
        "=" & Cells(Target.Row, i + col1 - 1).Interior.ColorIndex
       Cells(Target.Row, i + col1 - 1).Interior.ColorIndex = 6
    Next i
  End If
End Sub