Macro recherche puis suppression

Option Explicit

Sub Suppfeuilles()
Dim wkbSupp, Xrg As Range, Rep As String, Feuille As Worksheet
'Déterminer le classeur dont les feuilles sont à supprimer

Set Xrg = Nothing
On Error Resume Next
Set Xrg = Application.InputBox(prompt:="Sélectionner une cellule au sein " & _
  "du classeur dont les feuilles doivent être controlées puis supprimées", Type:=8)
On Error GoTo 0

If Xrg Is Nothing Then
  MsgBox "Vous avez choisi d'annuler: " & " => échec"
  Exit Sub
End If

wkbSupp = Xrg.Parent.Parent.Name
If wkbSupp = ThisWorkbook.Name Then
  MsgBox "Vous avez choisi le classeur: " & wkbSupp & " => échec"
  Exit Sub
End If

Rep = InputBox("Quel est le préfixe des feuilles à supprimer")

With Workbooks(wkbSupp)
  For Each Feuille In .Worksheets
    If LCase(Feuille.Name) Like LCase(Rep) & "*" Then
    On Error Resume Next
    Set Xrg = Nothing
    Set Xrg = Feuille.Range("AY1:DC41").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
      If Not Xrg Is Nothing Then
        If Xrg.Count = Feuille.Range("AY1:DC41").Count Then
          Application.Goto Feuille.Range("AY1:DC41"), True
          Feuille.Range("AY1:DC41").Select
          ActiveWindow.WindowState = xlMaximized
          ActiveWindow.Zoom = True
          If MsgBox("Suppression de la feuille " & Feuille.Name & " ?", _
                Buttons:=vbCritical + vbYesNo + vbDefaultButton2) = vbYes Then
            Application.DisplayAlerts = False
            Feuille.Delete
            Application.DisplayAlerts = True
          Else
            ActiveWindow.Zoom = 100
          End If
        End If
      End If
    End If
  Next Feuille
End With
End Sub