VBA : ouvrir tous les fichiers xls du répertoire courant

[C@thy]

Bonjour tout le monde,

c'est tout bête, mais j'ai oublié comment on fait en VBA pour ouvrir tous les fichiers .xls du répertoire courant

quelquechose comme :

for each wb in workbooks... j'ai fait une recherche dans le forum mais je dois mal poser la question car j'ai plein de réponses mais qui ne correspondent pas.

en fait je veux supprimer tous les onglets feuil3 de tous les fichiers .xls du répertoire. Quelqu'un(e) peut-il (elle) venir à mon secours?

Merci pour votre aide et à bientôt

C@thy (je ne suis pas dans mon bureau donc je n'ai pas le lien du bip bip sous la main, mais il est sur TiVéri rubrique image des excelliennes.

Biz et bonne journée

 

[EricS]

Bonjour,

tu trouveras un exemple dans le fichier joint mais je fais l'ouverture dans un sous-répertoire et non le répertoire courant (qui contient le fichier qui contient la macro et qui voudra donc s'ouvrir lui-même)


Sheets("Feuil3").Select
ActiveWindow.SelectedSheets.Delete


A+
Eric

 

[EricS]

RE

C'est mieux avec le fichier

Eric

 

[C@thy]

Merci EricS, mais... horreur et damnation, j 'ai des hiéroglyphes sur la pièce jointe,
pourrais-tu me donner le code pour ouvrir tous les fichiers .xls du répertoire?

MERCI

Biz

C@thy

 

[C@thy]

Merci EricS, mais... horreur et damnation, j 'ai des hiéroglyphes sur la pièce jointe,
pourrais-tu me donner le code pour ouvrir tous les fichiers .xls du répertoire?

MERCI

Biz

C@thy

 

[EricS]

re

voilà le code qui va chercher les fichiers du sous répertoire Données, les parties critère, tri et copier coller ne te concernent pas :

chemin = ThisWorkbook.Path & "\Données\"
nomfichier = ActiveWorkbook.Name
critère = "dupont"
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "Ce dossier contient " & .FoundFiles.Count & _
" fichier(s) répondant aux critères."
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
MsgBox .FoundFiles(i)
Workbooks.Open FileName:=fichierlu
fenêtrelue = ActiveWorkbook.Name
Range("a1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=critère
' taille de la sélection à copier
Range("a65536").Select
Selection.End(xlUp).Select
If ActiveCell.Value <> 1 Then
dernière_ligne = ActiveCell.Row
Range("A2:E" & dernière_ligne).Select
Selection.Copy
Windows(nomfichier).Activate
'mettre à la suite
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Windows(fenêtrelue).Activate
' Selection.AutoFilter Field:=2
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.Close SaveChanges:=False
Windows(nomfichier).Activate
Range("A1").Select

Next i
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With

si dans le répertoire tu as différents fichiers (xls et autres), il faudra sans doute adapter

A+
Eric

 

[C@thy]

Merci EricS,
ou la la, y'a beaucoup trop de code pour ce que je veux faire :

juste ouvrir tous les fichiers excel et supprimer l'onglet feuil3 si ce nom existe.

quelqu'un a-t-il (elle) plus simple???

MERCI

C@thy

 

[EricS]

RE

tu sais, beaucoup d'hypothèses (tous les fichiers XL, si feuil3 existe) te génère du code...

essaie le fichier joint (si il passe) sinon le code suit

tu places le fichier dans un répertoire et tu mets tous les autres dans un sous répertoire Données (fichiers xl, textes....) normalement seul les xl seront touchés

code :

Sub suppression()
chemin = ThisWorkbook.Path & "\Données\"
nomfichier = ActiveWorkbook.Name
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
If Right(fichierlu, 4) = ".xls" Then
Workbooks.Open FileName:=fichierlu
existe = 0
For j = 1 To Sheets.Count
If Sheets(j).Name = "Feuil3" Then existe = j
Next j
Application.DisplayAlerts = False
If existe <> 0 Then
Sheets(existe).Delete
Application.DisplayAlerts = True
ActiveWindow.Close SaveChanges:=True
End If
Windows(nomfichier).Activate
Range("A1").Select
End If
Next i
Else
MsgBox "Aucun fichier n'a été trouvé dans Données."
End If
End With

End Sub



A+

Eric

 

[michel_m]

Salur C@thy sans bipbiphelas, Eric

Ci joint une proposition (XL2000/win98.2)

Home.xls doit se trouver dans le m^me répertoire que les classeurs à travailler

J'ai écrit une sous-macro pour utiliser le systme à d'autres boulots avec la fonction "dir"

A+

Michel

 

[C@thy]

Merci michel_m, ça fonctionne bien. J'ai pu lire la P.J. car je suis revenue à mon bureau.

Biz et @+

C@thy