VBA / Générer un inventaire ignorer les cellules vides

Option Explicit
Sub essai()
Select Case MsgBox("La procédure va supprimer des données" _
                   & vbCrLf & "" _
                   & vbCrLf & "Voulez vous continuer" _
                   , vbYesNo Or vbExclamation Or vbDefaultButton1, "Attention")

    Case vbYes
        
    Case vbNo
        Exit Sub
End Select
Suprimer2 ("Feuil2")
End Sub

Sub Suprimer2(Nomfeuille1 As String)
Dim Cel1 As Range, Cellule1 As Range
Dim S1 As Worksheet
Dim Li1 As Long, Li2 As Long, col1 As String

col1 = "a"
If Nomfeuille1 <> "" Then
    With Worksheets(Nomfeuille1)
    'suppression des lignes
    For Each Cellule1 In .Range(col1 & "2:" & col1 & .Range(col1 & .Rows.Count).End(xlUp).Row)
        Set Cel1 = .Range("B" & Cellule1.Row & ":" & "G" & Cellule1.Row).SpecialCells(xlCellTypeBlanks)
          If Cel1.Count = 6 Then Cellule1 = ""
    Next Cellule1
    End With
    'suppression des lignes si la cellule de la colonne a est vide
        Set S1 = Worksheets(Nomfeuille1)
        Set Cel1 = S1.Range("a:a").SpecialCells(xlCellTypeBlanks) 'Cellules vides
        Cel1.EntireRow.Delete Shift:=xlUp
    ' suppression des lignes restantes
        Set Cel1 = S1.Range("a:a").SpecialCells(xlCellTypeBlanks)
        Li1 = Cel1.Row
        Set Cel1 = S1.Range("a:a").SpecialCells(xlCellTypeLastCell) 'Dernière cellule utilisée dans la plage 
        Li2 = Cel1.Row
        S1.Rows(Li1 & ":" & Li2).Delete Shift:=xlUp
End If
End Sub

Sub essai()
 With Sheets("Feuil1")
        .Copy after:=Sheets(Sheets.Count)
  '      On Error GoTo PbNomFeuille
        ActiveSheet.Name = "EtatStoc" ' référence
  '
    End With

Suprimer2 ("EtatStoc")
End Sub