[XL-2010] Code qui bloque et fige la feuille

Bonjour
J'ai un petit problème avec le code suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Private Sub Worksheet_Change(ByVal Target As Range)
'Quand les cellules de la colonne B change.
'Que le texte de la cellule contient "rifier" alors :
'On met la numérotation de la colonne A à jour et
'On formate les cellule avec bordures.
 
Dern_numero = Range("B" & Rows.Count).End(xlUp).Row
 
    If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
        Application.ScreenUpdating = False
        Set Page = Worksheets("Page2")
        Numero = 1
            With Page
                For i = 2 To Dern_numero
                    If .Cells(i, 2).Value Like "*rifie*" Or .Cells(i, 2).Value Like "*rifié*" Then
                        .Cells(i, 1) = Numero
                        Numero = Numero + 1
                        .Cells(i, 1).Borders.Weight = 2
                        .Cells(i, 1).Borders.Color = 1
                        .Cells(i, 1).Font.Name = "Arial"
                        .Cells(i, 1).Font.Size = 9
                        .Cells(i, 1).Font.Bold = True
                        .Cells(i, 2).Borders.Weight = 2
                        .Cells(i, 2).Borders.Color = 1
                        .Cells(i, 2).Font.Name = "Arial"
                        .Cells(i, 2).Font.Size = 9
                        .Cells(i, 2).Font.Bold = False        
                    End If
                Next
            End With
    End If   
End Sub

En effet tout se passe bien quand je complète la cellule.
Par contre quand je supprime une ligne la page reste figée et je ne peux plus rien faire.
N'y a t-il pas un moyen pour faire en sorte que quand j'efface le contenu d'une cellule en B la ligne soit supprimée ?
Merci pour votre aide.
Je réponds moi même grace à un autre forum en fait il suffisait d'ajouter au début de la procédure :

Code:

If Target.Count > 1 Then Exit Sub