Macro pour inscrire un libellé dans certaines cellules sous conditions...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([M7:X50], Target) Is Nothing Then
        Target = "compatible"
 ElseIf Not Intersect([Y7:AD50], Target) Is Nothing Then
        Target = "autorisé"
  End If
End Sub

Sub Insère()
Dim tablo
tablo = [F7:F50] 'matrice, plus rapide
Macro tablo, [M7:X50], "incompatible"
Macro tablo, [Y7:AD50], "interdit"
End Sub

Sub Macro(tablo, zone As Range, mot$)
Dim t, ncol%, i&, vide As Boolean, j%
t = zone 'matrice, plus rapide
ncol = UBound(t, 2)
For i = 1 To UBound(t)
  vide = tablo(i, 1) = ""
  For j = 1 To ncol
    If vide Then
      t(i, j) = ""
    ElseIf t(i, j) = "" Then
      t(i, j) = mot
    ElseIf t(i, j) = mot Then
      t(i, j) = ""
    End If
  Next
Next
zone = t
End Sub

Sub Insère()
Dim tablo As Range, z1 As Range, z2 As Range, t1$, t2$, z As Range, n&
Set tablo = [F7:F50]: Set z1 = [M7:X50]: Set z2 = [Y7:AD50]
t1 = "incompatible": t2 = "interdit"
Set z = Union(z1, z2)
On Error Resume Next
Intersect(z, tablo.SpecialCells(xlCellTypeBlanks).EntireRow).ClearContents
Set z = Intersect(z, tablo.SpecialCells(xlCellTypeConstants).EntireRow)
Set z1 = Intersect(z1, z): Set z2 = Intersect(z2, z)
n = Application.CountIf(z1, t1) + Application.CountIf(z2, t2)
z1.Replace IIf(n, t1, ""), IIf(n, "", t1), xlWhole
z2.Replace IIf(n, t2, ""), IIf(n, "", t2)
End Sub

Sub Insère()
Dim tablo As Range, z1 As Range, z2 As Range, t1$, t2$, z As Range, n&
Set tablo = [F7:F50]: Set z1 = [M7:X50]: Set z2 = [Y7:AD50]
t1 = "incompatible": t2 = "interdit"
Set z = Union(z1, z2)
On Error Resume Next
Intersect(z, tablo.SpecialCells(xlCellTypeBlanks).EntireRow).ClearContents
Err.Clear
Set z = Intersect(z, tablo.SpecialCells(xlCellTypeConstants).EntireRow)
If Err Then Exit Sub
Set z1 = Intersect(z1, z): Set z2 = Intersect(z2, z)
n = Application.CountIf(z1, t1) + Application.CountIf(z2, t2)
z1.Replace IIf(n, t1, ""), IIf(n, "", t1), xlWhole
z2.Replace IIf(n, t2, ""), IIf(n, "", t2)
End Sub