Supprimer plusieurs cellules automatiquement

Sub test()
DerLig = Range("A" & Application.Rows.Count).End(xlUp).Row
DerCol = Cells(1, Application.Columns.Count).End(xlToLeft).Column
End Sub

Private Sub SupLigne()
    Dim lgLig As Long
    Dim bTrouve As Boolean
    Dim lgDerLig As Long
    Dim lgDerCol As Long
        
    Application.ScreenUpdating = False
    
    ' Trouver la dernière cellule de la feuille
    ActiveCell.SpecialCells(xlLastCell).Select
    ' Dernière ligne
    lgDerLig = ActiveCell.Row
    ' Dernière colonne contenant le plus grand nombre de lignes
    lgDerCol = Cells(lgDerLig, Cells.Columns.Count).End(xlToLeft).Column
    
    
    ' Remplacer le point par une virgule pour avoir un format numérique
'    Cells.Select
'    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
'        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'        ReplaceFormat:=False
    
    Range("A1").Select
    
    bTrouve = False
    
    ' Boucle de la dernière à la première ligne
    For lgLig = lgDerLig - 1 To 1 Step -1
        ' Si la valeur de la cellule n'est pas numérique ou vide, on la supprime
        If Not IsNumeric(Cells(lgLig, lgDerCol).Value) Or Cells(lgLig, lgDerCol).Value = "" Then
            Cells(lgLig, lgDerCol).Select
            Selection.EntireRow.Delete
            
            bTrouve = True
        End If
    Next lgLig

    ' Sauvegarder le classeur pour permettre la récupération de la dernière ligne
    ActiveWorkbook.Save
    
    ' Trouver la dernière cellule de la feuille
    ActiveCell.SpecialCells(xlLastCell).Select
    ' Dernière ligne
    lgDerLig = ActiveCell.Row
    ' Dernière colonne contenant le plus grand nombre de lignes
    lgDerCol = Cells(lgDerLig, Cells.Columns.Count).End(xlToLeft).Column
    
    ' Suppression uniquement si des lignes numériques ont été supprimées
    If bTrouve = True Then
        ' Boucle de la dernière à la première ligne
        For lgLig = lgDerLig To 1 Step -5
            Cells(lgLig, lgDerCol).Select
            Selection.EntireRow.ClearContents
        Next lgLig
    End If

    Application.ScreenUpdating = True
End Sub

Private Sub cmdSupLigne_Click()
    Call SupLigne
End Sub