Problema al cambiar una celda en excel

Para Dante

Tengo un problema cada vez que cambio la celda I4 del INDICE, no ejecuta una una función que cuando pulso ESC, me lleva la hoja llamada INDICE. Pego el código

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Hojas As Worksheet
Dim Rango As Range
Dim celda As String
Dim mensajes As String
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    If Target.Address = "$I$4" Then
        mensaje = MsgBox("¿Desea limpiar el contenido de cada hoja?", vbYesNo + vbExclamation, strTitulo)
        If mensaje = vbNo Then
            'Sheets("CONFIGEMAIL").Activate
            'ActiveSheet.Cells(4, 3).Select
            Exit Sub
        End If
        For Each Hojas In ActiveWorkbook.Worksheets
            'With Hojas
            'Hojas.Select
            celda = Hojas.Range("ZZ101").Value
            If celda = "B" Then
                For Each Rango In Hojas.Range("G81:P111,Z81:AK111")
                    If (Rango.Value <> "") Then Rango.Value = ""
                Next Rango
                'Hojas.Range.Activate
                'Hojas.Range("G81:U111").ClearContents
                'Hojas.Range("Z81:AK111").ClearContents
            End If
            'End With
        Next Hojas
    End If
    'ThisWorkbook.Sheets("EMAIL").Delete
    Sheets("INDICE").Select
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub