Bonjour,
Je suis en train de faire un classeur sous Excel 2007 qui a pour but de faire un récapitulatif de plusieurs classeurs.
J'ai un dossier avec une multitude de classeurs, dans un premier temps je liste les noms de fichiers dans une feuille d'un nouveau classeur.
Les codes je l'ai trouvés sur Internet et je l'ai adapté.
Voici mon code :A partir de cette feuille et des noms de fichiers, je récupère les données que je veux dans plusieurs cellule.
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63 Sub triDecroissant_Fichiers_DateDreation() Dim Fichier As String, Chemin As String ' 'Nécessite d'activer la référence "Microsoft Scripting RunTime" ' Dim Fso As Scripting.FileSystemObject Dim FileItem As Scripting.File Dim Tableau() Dim Plage As Range Dim m As Integer, i As Integer Dim z As Byte, Valeur As Byte Dim Cible As Variant '---liste les fichiers du répertoire --- Chemin = "G:\Test\Factures Clients 2010\" Fichier = Dir(Chemin & "\*.*") 'pour filtrer sur un type de fichiers (par exemple xls) 'Fichier = Dir(Chemin & "\*.xls") 'Boucle sur les fichiers Do m = m + 1 ReDim Preserve Tableau(1 To 2, 1 To m) Tableau(1, m) = Fichier Set Fso = CreateObject("Scripting.FileSystemObject") Set FileItem = Fso.GetFile(Chemin & "\" & Fichier) 'Récupère la date de création Tableau(2, m) = Left(FileItem.DateCreated, 10) 'Pour récupérer la date de dernière modification Tableau(2, m) = Left(FileItem.DateLastModified, 10) 'Pour récupérer la taille du fichier 'Tableau(2, m) = Left(FileItem.Size, 10) Fichier = Dir Loop Until Fichier = "" '---Trie les fichiers par ordre décroissant de création --- Do Valeur = 0 For i = 1 To m - 1 If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then For z = 1 To 2 Cible = Tableau(z, i) Tableau(z, i) = Tableau(z, i + 1) Tableau(z, i + 1) = Cible Next z Valeur = 1 End If Next i Loop While Valeur = 1 '--- Transfère les données dans la feuille de calcul --- Set Plage = Worksheets("Feuil2").Range("A1") Set Plage = Plage.Resize(UBound(Tableau(), 2), UBound(Tableau())) Plage = Application.Transpose(Tableau()) End Sub
Voici mon code :
mon soucis vient que la somme totale de la facture ne se trouve pas toujours dans la même cellule.
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70 Option Explicit Sub Importer() Dim i As Long Dim sDossier As String, sFichier As String, sFeuille As String, sFeuille2 As String 'comptage du nombre de fichier Dim Chemin As String Dim rep As String Dim nbfichier As Integer Chemin = "G:\Test\Factures Clients 2010\" 'a adapter rep = Dir(Chemin & "*.xls") While Not rep = "" nbfichier = nbfichier + 1 rep = Dir Wend Application.ScreenUpdating = False liste.Range("A2:D65536").Clear sDossier = ThisWorkbook.Path & "\Factures Clients 2010\" sFeuille = "Entrée Data" 'Feuil1 Entrée Data sFeuille2 = "Facture " For i = 1 To nbfichier With liste Dim cell As String, cel As Long Cells(i, 1) = Worksheets("Feuil2").Range("A" & i) sFichier = Cells(i, 1) .Cells(i, 2) = ExtraireValeur(sDossier, sFichier, sFeuille, "H9") .Cells(i, 2) = CDate(Cells(i, 2)) 'Date .Cells(i, 3) = ExtraireValeur(sDossier, sFichier, sFeuille, "E32") .Cells(i, 3) = Cells(i, 3) 'Numéro de Client .Cells(i, 4) = ExtraireValeur(sDossier, sFichier, sFeuille, "E49") .Cells(i, 4) = Cells(i, 4) 'Institution .Cells(i, 5) = ExtraireValeur(sDossier, sFichier, sFeuille, "E31") .Cells(i, 5) = Cells(i, 5) 'Numéro de Contact .Cells(i, 6) = ExtraireValeur(sDossier, sFichier, sFeuille, "E43") .Cells(i, 6) = Cells(i, 6) 'Nom du contact .Cells(i, 7) = ExtraireValeur(sDossier, sFichier, sFeuille, "E40") .Cells(i, 7) = Cells(i, 7) 'Ville .Cells(i, 8) = ExtraireValeur(sDossier, sFichier, sFeuille, "E45") .Cells(i, 8) = Cells(i, 8) 'Téléphone .Cells(i, 9) = ExtraireValeur(sDossier, sFichier, sFeuille2, "F40") .Cells(i, 9) = Cells(i, 9) 'Somme End With Next i Application.ScreenUpdating = True End Sub Private Function ExtraireValeur(ByVal Dossier As String, ByVal Fichier As String, ByVal Feuille As String, ByVal cellule As String) Dim Argument As String Argument = "'" & Dossier & "[" & Fichier & "]" & Feuille & "'!" & Range(cellule).Address(, , xlR1C1) ExtraireValeur = ExecuteExcel4Macro(Argument) End Function
Je n'arrive pas à faire quelque chose qui marche
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Cells(i, 9) = ExtraireValeur(sDossier, sFichier, sFeuille2, "F40") .Cells(i, 9) = Cells(i, 9) 'Somme
J'ai essayer en récupérant le numéro de ligne car sur la même ligne, j'ai un texte fixe (Total à payer).
Comme c'est toujours dans la même colonne, je me suis dit je prends la dernière valeur de la cellule pleine.
cel = Range("F100").End(xlUp).row
Si quelqu'un pouvait m'aider ou m'éclairer![]()
Partager