Présence valeur et suppression ligne

Sub suppression()
Application.ScreenUpdating = False ' desactive rafraichissement écran
Dim Ligne As Long
Ligne = Sheets("Feuil1").Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row 'dernière ligne remplie
For n = Ligne To 2 Step -1 'boucle sur lignes de la dernière en remontant à la 2eme
existe = Application.WorksheetFunction.CountIf(Sheets("Feuil2").Range("AH:AH"), Sheets("Feuil1").Range("B" & n)) 'NB.SI valeur en B Feuil1 dans AH Feuil2
If existe = 0 Then Rows(n & ":" & n).Select: Selection.Delete 'effacement ligne si n'existe pas en Feuil 2
Next
Application.ScreenUpdating = True ' active rafraichissement écran
End Sub

Sub Bouton1_Cliquer()
    Dim I, DerLig As Long
    Dim Trouve As Range, PlageDeRecherche As Range
    Dim Valeur_Cherchee As String, AdresseTrouvee As String
    Application.ScreenUpdating = False
        
    DerLig = Worksheets("feuille 1").Range("B" & Rows.Count).End(xlUp).Row
    For I = 2 To DerLig
        If (Worksheets("feuille 1").Range("B" & I) <> "") Then
 '    affectation de valeurs aux variables :
            Valeur_Cherchee = Worksheets("feuille 1").Range("B" & I)
'        dans la première colonne de la feuille active
            Set PlageDeRecherche = Worksheets("Feuille 2").Range("AH2:AH" & DerLig)
'    méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
            Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
'    traitement de l'erreur possible : Si on ne trouve rien :
            If Trouve Is Nothing Then Rows(I).Delete shift:=xlUp
'    vidage des variables
            Set PlageDeRecherche = Nothing
            Set Trouve = Nothing
        End If
    Next I
    Application.ScreenUpdating = True
End Sub