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