compiler une même cellule de multiples fichiers excel à partir d'une liste d'adresse de ces fichiers

Version imprimable

Bonjour,

Je ne crois pas avoir bien résumé mon souhait dans l'intitulé, donc voici une explication un peu plus détaillée :

J'ai répertorié (grâce à une macro pris sur ce forum - MERCI :-) une liste de fichiers excel sous la forme adresse complète : T:\DFIN\_Echanges\2016_CA\880013827_CA2016.xls.
La liste contient plus de 200 adresses de fichiers, fichiers qui ont tous les mêmes onglets.
J'aimerai tout simplement aller chercher la cellule E7 de la feuille "FINESS", et la coller à coté de l'adresse, dans mon fichier contenant les adresses.

J'ai rédigé le code ci-dessous (en bidouillant d'autres macros) et je pense que le problème est à la ligne 11. La macro me renvoie le nom de fichier + "FINESS$E$7", ce qui est l'adresse et moi je voudrais la valeur à cette adresse.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub ExtraireLesCellules() 'Sélectionner les noms des fichiers à extraire avec Non ouverture des fichiers Application.ScreenUpdating = False 'pfile = Cells(1, 15) & "\" 'ActiveWorkbook.Path & "\archive\" 'indiquer ici le chemin du répertoire 'nfile = Dir(pfile) For Each cell In Selection 'nfile = cell 'Dir(pfile) 'Dir (nfile) Workbooks(ThisWorkbook.Name).Sheets(2).Range(cell.Address).Offset(0, 7).Value = Dir(cell) & "]FINESS'!$E$7" If Workbooks(ThisWorkbook.Name).Sheets(2).Range(cell.Address).Offset(0, 7).Value = 0 Then Workbooks(ThisWorkbook.Name).Sheets(1).Range(cell.Address).Offset(0, 1) = cell & "]FINESS'!$E$7" 'Stop Next Application.ScreenUpdating = True End Sub

21/02/2018, 16h37
Jean-Philippe André

SAlut,

tu as besoin de passer par INDIRECT()
essaie avec

Code:

Workbooks(ThisWorkbook.Name).Sheets(2).Range(cell.Address).Offset(0, 7).Formula= "=INDIRECT("Dir(cell) & "]FINESS'!$E$7)"
21/02/2018, 16h43
Joeytriviani

Merci JPA d'avoir répondu si vite.
Malheureusement, ça n'a pas fonctionné. Toute la ligne s'est mise en rouge !

En attendant, j'ai tenté autre chose, en partant d'une macro de silkyroad (http://silkyroad.developpez.com/VBA/...sFermes/#LIV-A), que j'ai bien sur adapté.
Et là, ça bug à la première ligne. Message : "Erreur de compilation : Type défini par l'utilisateur non défini".
Zut alors !

Quelqu'un pourrait il m'expliquer ? Pourquoi "DIM Source As ADODB.Connection" ne fonctionne pas ?

Je précise que je suis sur Excel 2010

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
Sub extractionValeurCelluleClasseurFerme()
    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String
 
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "E7"
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"
 
    Feuille = "FINESS$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
 
For Each cell In Selection
 
    Fichier = cell
 
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
 
    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
 
    Range(cell.Address).Offset(0, 7).CopyFromRecordset Rst
 
Next
 
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

21/02/2018, 17h50
Jean-Philippe André

UN oubli de ma part

Code:

Workbooks(ThisWorkbook.Name).Sheets(2).Range(cell.Address).Offset(0, 7).Formula= "=INDIRECT(" & Dir(cell) & "FINESS'!$E$7)"
21/02/2018, 17h55
Marc-L

Bonjour !

Jean-Philippe, Workbooks(ThisWorkbook.Name) équivaut juste à ThisWorkbook, non ?!

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
21/02/2018, 18h35
Jean-Philippe André

Oui, mais ce n'est pas sur cet élément que j'ai concentré mon attention :oops:
22/02/2018, 09h08
Joeytriviani

Merci JPA

La ligne n'est plus rouge. Mais elle bug quand je lance la macro !

Je vais lancer une nouvelle discussion pour la deuxième macro (celle issu de la page de silkyroad)

Bonne journée.