Supprimer les lignes lorsque la cellule A est vide, de tous les fichiers d'un dossier

Sub Collecte()
Dim NomFic As String, Chemin As String, Wb As Workbook
On Error Resume Next
'Scanne tous les fichiers .xls situés dans le même dossier que celui-ci
Chemin = ThisWorkbook.Path
ChDrive Chemin
ChDir Chemin
NomFic = Dir("*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
While NomFic <> ""
 If NomFic <> ThisWorkbook.Name Then
   
   'ouverture du classeur
   Set Wb = Workbooks.Open(Chemin & "\" & NomFic)
   With Wb
     'Effacement des lignes
     Intersect(.Sheets(1).Columns("A:A"), .Sheets(1).UsedRange).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     
     'Sauvegarde et fermeture du classeur
     .Close True
   End With
   
 End If
 
 'On passe au classeur suivant
 NomFic = Dir
   
Wend
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub