VBA-Excel07:Suppression de colonnes après sélection d'une valeur

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, [B2:E5]) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "YES" Then Exit Sub
  Call Supprime_Colonnes(Target.EntireRow.Cells(1, 1).Value, _
                         Target.EntireColumn.Cells(1, 1).Value)
End Sub

Private Sub Supprime_Colonnes(feuille As String, colonnes As String)
Dim i As Long
  
  With Worksheets("Feuille " & feuille).UsedRange.Rows(1)
    For i = .Cells.Count To 1 Step -1
      If InStr(1, .Cells(1, i).Formula, colonnes) = 1 Then
        .Cells(1, i).EntireColumn.Delete
      End If
    Next i
  End With

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
  Set r = Intersect(Me.UsedRange, Me.UsedRange.Offset(1, 1))
  If Intersect(Target, r.Cells) Is Nothing Then Exit Sub
  For Each c In Intersect(Target, r.Cells).Cells
    If c.Value = "NO" Then
      Call Supprime_Colonnes(c.EntireRow.Cells(1, 1).Value, c.EntireColumn.Cells(1, 1).Value)
    End If
  Next c
End Sub

'- ajouter l'individu
d.Resize(1, nbC_Id).Value = c.EntireRow.Cells(1, "A").Resize(1, nbC_Id).Value

'- ajouter les données de la feuille var
On Error Resume Next
Set w = Worksheets(c.EntireRow.Cells(1, colSrc).Value)
On Error GoTo 0
If Not w Is Nothing Then
  d.EntireRow.Cells(1, colVal).Resize(1, nbC_Val).Value = _
      w.Cells(2, colVal).Resize(1, nbC_Val).Value
End If