Bonjour a tous,

J`ai la macro ci-dessous qui me récupère les donnes voulues du répertoire contenant le classeur mais je voudrais en fait qu`il me récupère les données de fichiers étant ces répertoires :
D:\testlist\CMV01
D:\testlist\CMV42

Pourriez-vous m`aider car je modifie le Strfile et le chemin mais la macro ne fonctionne plus ensuite

Et 2eme contrainte si c`est possible, sélectionner les fichiers seulement compris entre 2 dates (les dates pourront être contenu dans des cellules du classeur feuil1 A1 et B1)

Apres cela cette macro devrait être nikel, merci à vous
Voici la macro à modifier :



Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String
 
 
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
 
' Nom du classeur actuel
strWB = ThisWorkbook.Name
 
' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir ThisWorkbook.Path & "\*.html")
 
' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Calcul2").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile
 
Chemin = ThisWorkbook.Path & "\" & strFile
Set Objet = CreateObject("Scripting.FileSystemObject")
Set Fichier = Objet.GetFile(Chemin)
 
' Copie des données
Workbooks(strFile).Worksheets(1).Range("A11:C28").Copy
With Workbooks(strWB).Worksheets("Calcul2")
  .Range("A2").Insert xlDown 'insertion en ligne 2
  .Range("c2:c19").ClearContents 'on ne garde que les données A2:B17
  .Range("C3") = strFile
  .Range("c2") = Fichier.DateLastModified
 
 
End With
 
' Fermeture du classeur
Workbooks(strFile).Close
End If
 
' Classeur suivant
strFile = Dir
Loop
 
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub