Suppression ligne multi classeur
Résolustitchbouck Messages postés 137 Statut Membre -
Bonjour,
Je cherche à supprimer des lignes selon le critère (différent de "01"), si possible sur l'ensemble d'un dossier contenant plusieurs fichiers Excel.
Le critère se trouve toujours dans la colonne "A" de chaque feuille, et ce sur chaque fichier (6 fichiers actuellement). Il peut y avoir un nombre différent de feuille dans les fichiers, il peut y avoir plus de 6 fichiers. Le dossier ne contient QUE des fichiers Excel que je veux manipuler.
Supprimer dans une même feuille, j'ai trouvé :
Sub effacer()
dl = Range("A65356").End(xlUp).Row
For n = dl To 2 Step -1
If Range("A" & n) <> "01" Then Range("A" & n).EntireRow.Delete
Next n
End Sub
Merci à @via55 StatutMembre, j'ai repris son travail sur un autre sujet et je l'ai adapté à ma première feuille d'un de mes fichiers.
Mais comment appliquer cela à tout le classeur ? Régler ce point est déjà super.
Si en plus, une solution existe pour appliquer le code à l'ensemble des fichiers d'un dossier depuis un seul fichier Excel... (UN fichier pour les contrôler tous ! haha !), ben ça serait encore plus fort. et encore plus pratique.
Un grand merci à vous, et en espérant être compréhensible.
Windows / Edge 115.0.1901.188
2 réponses
-
Bonjour
Heureux que mon travail ait pu t’être utile
Pour boucler sur toutes les feuilles d'un classeur :
For n = 1 To Sheets.Count Sheets(n).Select Next
Il suffit ensuite d'insérer ta macro d'effacement avant le Next
Pour boucler sur tous les classeurs d'un dossier :
https://excelcorpo.com/ouverture-de-tous-les-classeurs-a-partir-dun-dossier-avec-excel-vba/
Cdlmnt
Via
-
Bonjour,
super merci beaucoup !!
Au final ça donne :
Sub OuvertureTousClasseurs() 'Étape 1: Déclaration des variables Dim MesFichiers As String 'Étape 2: Indication du répertoire cible MesFichiers = Dir("chemin accès jusqu'au dossier\*.xlsx") Do While MesFichiers <> "" 'Étape 3: Ouvrez plus de classeurs Updatingscreen = False Workbooks.Open "chemin accès jusqu'au dossier\" & MesFichiers For b = 1 To Sheets.Count Sheets(b).Select dl = Range("A1048576").End(xlUp).Row For n = dl To 2 Step -1 If Range("A" & n) <> "01" Then Range("A" & n).EntireRow.Clear 'clear va plus vite que delete, dans mon cas ça suffit car tout est trié Next n Next b 'Exécution de certains codes MsgBox ActiveWorkbook.Name 'perso je l'ai désactivé ActiveWorkbook.Close SaveChanges:=True 'Étape 4: Le fichier suivant du dossier MesFichiers = Dir Loop End SubCa fonctionne très bien. par contre une fois fait, vaut mieux que je relance mon pc car je me retrouve avec des lenteurs...
Merci à tous !
