Boucle sélectionnant certain fichier d'un répertoire

Bonjour à tous,

Je voudrais faire une recherche de fichiers dans un répertoire en fct de critères. Je débute en VBA et J'ai besoin d'aide car je ne trouve pas comment faire.

voici le modèle de fichier dans le répertoire C:\users\......\ZB_AT\

W_ZB_AT_BA.xlsm

W_ZB_AT_BAC.xlsm

W_ZB_AT_BABA.xlsm

W_ZB_AT_BE.xlsm

W_ZB_AT_EI.xlsm

W_ZB_AT_GET.xlsm

etc

seul les 3 ou 4 derniers caractères des fichiers changent :

Je voudrais ne sélectionner que les fichiers par rapport à ces caractères. Par exemple , sélectioner les fichier de " W_ZB_AT_B*.xlsm" à "W_ZB_AT_G*.xlsm"

J'ai créer une boucle qui va sur tous les fichiers du répertoire

et je choisis les fichiers en fct de la 1ère lettre du 4ème mot ; jusque là tout va bien...

donc j'écris Fichier Dir(Chemin &" \W_ZB_AT_B*.xlsm")

mais je ne sais pas comment dire à la boucle de continuer après les B* jusqu'aux G* par exemple...

Dans mon code , elle ne sélectionne que les B*

Voici mon code

Sub Boucle_While_Fichiers_selon_lettre_alphabet()

Dim Chemin As String, Fichier As String

'Définit le répertoire contenant les fichiers

Chemin = "C:\users\JF22M22\Bourse\S_J\ZB_AT\"

'Boucle sur tous les fichiers xlsm du répertoire dont le 4ème mot commence par tel " lettre " (B dans ce cas).

Fichier = Dir(Chemin & "\W_ZB_AT_B*.xlsm")

Do While Len(Fichier) <> 0 ' continue la boucle tant que la condition est vrai

' écrit le résultat dans la fenêtre d'exécution (Ctrl+G).

Debug.Print Chemin & Fichier

Fichier = Dir()

Workbooks.Open Chemin & Fichier

Range("l24") = Now()

ActiveWorkbook.RefreshAll

ActiveWorkbook.Save

ActiveWorkbook.Close

Loop

End Sub

Et cerise sur le gâteau, si je pouvais entrer la valeur de départ et de fin avec une imputbox , ça serait merveilleux.

Si vous pouviez m'aider, ça serait super sympa.

Merci d'avance

Bonsoir,

Ci-joint une proposition à tester.

Bonne soirée

Bouben

Bonsoir,

Tout fonctionne à merveille. C'est exactement ce que je voulais. C'est trop génial ! un tout, tout grand merci !

Mais pour pouvoir arriver à ce niveau , qu'est-ce que je dois encore bosser.... encore merci et bonne soirée.

Bonjour,

Au départ cette macro fonctionnait à moitié; juste qu'elle bloquait vers la 20ème recherche. En essayant des modifs pour régler le problème, plus rien ne fonctionne maintenant et je suis complètement perdu, je ne m'y retrouve plus. La boucle ne se fait plus.

Pourriez-vous m'aider car je cherche depuis 4 jours et je ne trouve pas la solution .....

Merci d'avance

[coOption Explicit

Private Sub cmdGo_Click()

Etudier

End Sub

Private Sub Etudier() ' la bonne macro

Dim sLettreDeb As String

Dim sLettreFin As String

Dim bFin As Boolean

Dim ilettre As Integer

'saisie lettre début

bFin = False

While Not bFin

sLettreDeb = InputBox("Lettre début")

If sLettreDeb = "" Then

Exit Sub

ElseIf Len(sLettreDeb) <> 1 Then

MsgBox "Veuillez saisir une seule lettre !", vbExclamation

Else

bFin = True

End If

Wend

sLettreDeb = UCase(sLettreDeb)

'saisie lettre fin

bFin = False

While Not bFin

sLettreFin = InputBox("Lettre fin")

If sLettreFin = "" Then

Exit Sub

ElseIf Len(sLettreFin) <> 1 Then

MsgBox "Veuillez saisir une seule lettre !", vbExclamation

ElseIf Asc(UCase(sLettreFin)) < Asc(sLettreDeb) Then

'vérif fin > début

MsgBox "La lettre de fin doit être > à la lettre de début !", vbExclamation

Else

bFin = True

End If

Wend

sLettreFin = UCase(sLettreFin)

'boucle de la 1ère à la dernière

For ilettre = Asc(sLettreDeb) To Asc(sLettreFin)

Boucle_While_NomFichs_selon_lettre_alphabet (Chr(ilettre))

Next ilettre

End Sub

Private Sub Boucle_While_NomFichs_selon_lettre_alphabet(psLettre As String)

'la bonne macro

Dim Chemin As String, NomFich As String, chemin_complet As String

Dim NomFich_Macro As Workbook

Dim NomFich_requete As Workbook

Dim Workbook As Object

Dim ilettre As String

Set NomFich_Macro = ThisWorkbook

ThisWorkbook.Sheets("feuil1").Range("M1") = Now()

'Définit le répertoire contenant les NomFich

Chemin = "C:\users\JF22M22\Bourse\S_J\ZB_AT\"

NomFich = Dir(Chemin & "W_ZB_AT_" & psLettre & "*.xlsm")

chemin_complet = Chemin & NomFich

Set NomFich_requete = ActiveWorkbook

Do While Len(NomFich) <> 0 ' continue la boucle tant que la condition est vrai

Call ClasseurOuvert(NomFich) 'on ouvre le NomFich contenant les requêtes

With ActiveWorkbook.Sheets("Feuil1").Select

ActiveWorkbook.RefreshAll 'on actualise les données

ActiveWorkbook.Sheets("feuil1").Range("M1") = chemin_complet 'on écrit le chemin du NomFich

ActiveWorkbook.Sheets("feuil1").Range("J29").Select 'on effectue une mise en forme

Selection.Copy

Sheets("feuil1").Range("J30").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

etc mise en forme

----

----

ActiveWorkbook.Save

ActiveWorkbook.Close

End With

NomFich = Dir()

Loop

End Sub

Function ClasseurOuvert(NomFich)

On Error Resume Next

Workbooks(NomFich).Activate

If Err <> 0 Then Workbooks.Open Filename:=NomFich

On Error GoTo 0

End Functionde][/code]