XL 2013 Recupérer données dans un classeur fermé bilan horaire annuel.

[BIROULIG]

Bonjour

étant toujours débutant . mon Projet est le suivant
Je reçois 12 classeurs (feuille d'heures JANVIER.XLS FEVRIER.XLS ....) que je ne peux modifier et la solution de mettre les 12 mois dans un seul classeur inenvisageable.

Je désire dans le fichier BILAN faire la synthèse annuelle en allant récupérer le cumul par mois contenu dans les 12 fichiers dans la cellule fusionnée C42.

J'ai trouvé sur le forum un sujet qui traitait le problème . Mais mes connaissances sont trop limitées.
J'ai tenté de l'adapter mais ça bloque: un souci avec le chemin,
Et je désire faire une boucle pour récupérer le 12 valeurs mensuelles, en concaténant le chemin , le mois et le type de fichier (par exemple avec le nom du fichier contenu dans la colonne A du classeur bilan).
J'espère avoir été suffisamment clair.
Merci pour votre aide.

F:\DOSSIER FICHES HEURES ALSH\2021\
+
mois en "A2", "A3" .... feuil1 dans cumul.xls
+extension xls

Sub importer()
 Dim Source As Object
 Dim Rst As Object
 Dim ADOCommand As Object
 Dim Chemin As String, Cellule As String, Feuille As String
 Dim Cellule2 As String, Fichier As String
 
'------------------------------------------------------------------------
'---------Importation Données depuis Classeur Fermé------------
'------------------------------------------------------------------------
 
 'Plage variable des cellules contenant les données à récupérer dans le classeur fermé
 'Variabilité de la plage obtenue par une commande Concatener dans la feuille actuelle
 Cellule2 = "C42"
 
   'Pour une plage de cellules, utilisez: Cellule = "A4:C10" et une simple cellule : cellule = "A4"
 
 'Nom de la feuille ou onglet variable ciblé dans le classeur fermé
 'Variabilité de la feuille obtenue par une commande Concatener dans la feuille actuelle
 'Feuille = "M01"
 Feuille = "Feuil1$"
   'N'oubliez pas d'ajouter $ au nom de la feuille.
   'Pour une feuille connue, utilisez : Feuille = "Exemple$"
 
 'Chemin complet et variable du classeur fermé
 'Variabilité obtenue par une commande Concatener dans la feuille actuelle
 Chemin = Range("M02").Value
   'Pour un chemin unique défini, utilisez : Chemin = "C:\Utilisateur\Bureau\Test.xls"
 
 'Instance LateBinding pour connexion au classeur fermé sans activation préalable
 'de Microsoft ActiveX Data Objects 2.0 Library
 Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & _
        ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";" '
 
 Set ADOCommand = CreateObject("ADODB.Command")
 With ADOCommand
   .ActiveConnection = Source
   .CommandText = "SELECT * FROM  [" & Feuille & Cellule2 & "]"
 End With
 
 Set Rst = CreateObject("ADODB.Recordset")
 Rst.Open ADOCommand, , 1, 3
   '1 = adOpenKeyset, 3 = adLockOptimistic
 
'Copie le contenu des cellules dans le classeur ouvert (actuel)
 Set Rst = Source.Execute("[" & Feuille & Cellule2 & "]")
 
 Range("B2").CopyFromRecordset Rst
   'Pour une plage de cellule connue, utilisez : Range("A4:C10").CopyFromRecordset Rst
 
 Rst.Close
 Source.Close
 Set Source = Nothing
 Set Rst = Nothing
 Set ADOCommand = Nothing
 
End Sub

 

[job75]

Bonjour BIROULIG,

Avec des formules de liaison c'est vraiment très simple :

Sub Importer()
Dim chemin$, feuille$, mois As Range, fichier
chemin = [M2]
'chemin = ThisWorkbook.Path & "\" 'chez moi c'est mieux pour tester...
feuille = [M1]
Application.ScreenUpdating = False
For Each mois In [A2:A13]
    fichier = Dir(chemin & mois & ".xls") 'extension à adapter
    If fichier <> "" Then
        mois(1, 2) = ExecuteExcel4Macro("'" & chemin & "[" & fichier & "]" & feuille & "'!R42C3") 'cellule C42
    Else
        mois(1, 2) = ""
    End If
Next
End Sub

A+

 

[BIROULIG]

Bonjour Job 75
C'est tout nickel et en plus simple merci encore pour . et hyper rapide la réponse.
Application.ScreenUpdating : sert à mettre l'affichage en pause le temps que la macro soit finie et soulager le traitement si j'ai bien compris les explications sur le forum.
J'avais vu ExecuteExcel4Macro mais pas plus de succès.
A+

 

[micheldu52]

Bonjour BIROULIG,

Avec des formules de liaison c'est vraiment très simple :

Sub Importer()
Dim chemin$, feuille$, mois As Range, fichier
chemin = [M2]
'chemin = ThisWorkbook.Path & "\" 'chez moi c'est mieux pour tester...
feuille = [M1]
Application.ScreenUpdating = False
For Each mois In [A2:A13]
    fichier = Dir(chemin & mois & ".xls") 'extension à adapter
    If fichier <> "" Then
        mois(1, 2) = ExecuteExcel4Macro("'" & chemin & "[" & fichier & "]" & feuille & "'!R42C3") 'cellule C42
    Else
        mois(1, 2) = ""
    End If
Next
End Sub

A+

un merci job75.... cela m'a bien aidé....
Cordialement
Michel