Recherche valeur cellule dans plusieurs classeurs fermés

**Millenniums** · 19/04/2011, 11h55

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 :

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

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 :

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

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
Cells(i, 9) = ExtraireValeur(sDossier, sFichier, sFeuille2, "F40")
            .Cells(i, 9) = Cells(i, 9) 'Somme

Je n'arrive pas à faire quelque chose qui marche

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

**MarcelG** · 19/04/2011, 13h32

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Millenniums** · 19/04/2011, 14h11

J'ouvre le classeur avec la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

merci

**MarcelG** · 19/04/2011, 16h02

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Millenniums** · 19/04/2011, 20h32

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é

Recherche valeur cellule dans plusieurs classeurs fermés

Macros et VBA Excel

Discussions similaires

Partager

Partager