Discussion :

[flosauveur69]

Bonjour à tous,

mon problème est le suivant: je voudrais récupérer une cellule (B1) dans plusieurs fichiers excel d'un répertoire et mettre toutes ces cellules B1 dans un tableau dans un fichier maitre. Ex: la cellule B1 du fichier 1 en A1 du fichier maitre, la cellule B1 du fichier 2 en A2 du fichier maitre etc...

Sachant que les fichiers "esclaves" ont des noms différents et ont un seul onglet.

Je pense qu'un macro serait nécessaire mais je ne saurai pas la développer. De plus, je voudrais récupérer ces cellules A1 sans avoir à ouvrir les fichiers esclaves car cela serait beaucoup trop long.

Merci d'avance.

nb: j'ai mis en pièce jointe un exemple de fichier esclave

[SilkyRoad]

Bonjour,

Tu peux tester et adapter cette procédure :

Code :

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

1
2
3
4
5
6
7
8
9
10
Option Explicit
 
 
Sub Test()
    Range("A1") = LireCellule_ClasseurFerme( _
        "C:\Documents and Settings\dossier", _
        "Classeur1.xls", _
        "Feuil1", _
        Range("B1"))
End Sub

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
Function LireCellule_ClasseurFerme( _
        Chemin As Variant, _
        Fichier As Variant, _
        Feuille As Variant, _
        Cellule As Variant) As Variant
 
    Application.Volatile
 
    Dim Source As Object, Rst As Object, ADOCommand As Object
    Dim Cible As String
 
    Feuille = Feuille & "$"
    Cible = Cellule.Address(0, 0, xlA1, 0) & ":" & _
        Cellule.Address(0, 0, xlA1, 0)
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & "\" & Fichier & _
        ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
    Set ADOCommand = CreateObject("ADODB.Command")
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cible & "]"
    End With
 
    Set Rst = CreateObject("ADODB.Recordset")
    '1 = adOpenKeyset, 3 = adLockOptimistic
    Rst.Open ADOCommand, , 1, 3
    Set Rst = Source.Execute("[" & Feuille & Cible & "]")
 
    LireCellule_ClasseurFerme = Rst(0).Value
 
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Function

bonne soirée
michel