[XL-2007] Recherche valeur cellule dans plusieurs classeurs fermés

Recherche valeur cellule dans plusieurs classeurs fermés

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 :

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
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

A partir de cette feuille et des noms de fichiers, je récupère les données que je veux dans plusieurs cellule.

Voici mon code :

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
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

mon soucis vient que la somme totale de la facture ne se trouve pas toujours dans la même cellule.

Code:

1
2
Cells(i, 9) = ExtraireValeur(sDossier, sFichier, sFeuille2, "F40")
            .Cells(i, 9) = Cells(i, 9) 'Somme

Je n'arrive pas à faire quelque chose qui marche :cry:

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 :merci:

Bonjour Millenium, Bonjour le Faux Rhum (allusion à l'ami casefayere qui est caviste),

Citation:

Comme c'est toujours dans la même colonne, je me suis dit je prends la dernière valeur de la cellule pleine.

En effet, tu peux essayer par concaténation
Code:

1 2 cel = Workbooks(sFichier).Sheets(sFeuille).Range("F100").End(xlUp).row Cells(i, 9) = ExtraireValeur(sDossier, sFichier, sFeuille2, "F" &cel)
Cela suppose que le classeur soit ouvert en premier lieu.
Tu peux coder en ce sens.

Sinon, tu peux t'aider du tutoriel

Lire Classeurs Fermés par Silkyroad

J'ouvre le classeur avec la fonction :
Code:

1 2 3 4 5 6 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
J'ai lu le tutos et relus mais j'avoue que je suis un peu plus perdu :roll:

votre solution de concaténation est presque une que j'avais testé mais là aussi j'ai une erreur d'indice (erreur d'exécution '9') sur la ligne

Code:

cel = Workbooks(sFichier).Sheets(sFeuille).Range("F100").End(xlUp).row

merci

recherchev

Milleniums,

Si l'en-tête de ligne est constant pour ce type de montant (exemple : Total)
En effectuant une recherchev, d'après ce même tutoriel

'Faire une RECHERCHE Verticale dans un classeur fermé:
'Rechercher "Total" dans la colonne A du classeur fermé et afficher la donnée correspondante de la colonne F.
Code:

1 2 3 4 With Cells(i,9) .Formula = WorksheetFunction.VLookup("Total";la référence telle qu'écrite dans le tutoriel et à adapter) .Value = .Value End With

Merci MarcelG

Mais je suis complètement dans les choux là

Dans une de mes idées :
.je recherche quelle est la ligne où on trouve Total
.puis je récupère la valeur dans colonne et la ligne trouvée

je ne pensais pas que c'étais aussi compliqué