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

[Jex94]

Bonjour,

J'ai un dossier comportant de nombreux dossiers, et je souhaiterais effectuer les opérations suivantes :

- Ouvrir le 1er fichier du dossier (chaque fichier a des données en colonne 1 à 4, sur un nombre de lignes variable, et certaines lignes ont la colonne A qui est vide)

- Supprimer les lignes de ce fichier lorsque la cellule A est vide

- Enregistrer et fermer

- et refaire l'opération sur tous les fichiers suivants de ce dossier

Merci beaucoup par avance.
Je viens de passer 5 heures à essayer de le faire moi même, sans succès

Je mets en pièces jointes 2 fichiers de mon dossier pour exemple.

Cordialement,
Jex

 

[Softmama]

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

Bonjour,

Vois si le répertoire joint répond à ta demande (il faut que le fichier Gérer les fichiers dans un dossier soit dans le même dossier que les fichiers à gérer).

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

 

[Jex94]

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

Salut Softmama,

Ca fonctionne parfaitement merci beaucoup !!

A + bye