Modification d`une macro pour récuperation données dans 2 fichiers et si possible entre 2 dates
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:
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 |
