Extraction multi classeurs

[ShuarS]

Bonjour à tous les XLDnaute

Pourriez vous m'aider à construire un bout de code pour réaliser des extractions multi classeurs svp ?

Le dossier "synthese" est directement sous C:\ <C:\synthese>​

Il contient x classeurs Excel enregistrés en .xlsm​

Tous ces classeurs ont tous la même base. Cf fichier "modele" ci joint.​

Tous ces classeurs ont un nom différent. Ex : modele; modele1; modele2; etc.​

Tous ces classeurs contiennent x feuilles avec un nom différent.​

Je voudrais faire un code pour : Cf fichier "consolide" ci joint.

Créer un nouveau classeur en .xlsx sous <C:\temp>​

Le nommer "consolide"​

Ecrire en colonne A tous les noms des différents fichiers xlsm contenus dans le dossier systhese.​

Ecrire en colonne B le nom de la feuille appelée pour le classeur. Ex : 2019 Sem 50​

Ecrire en colonne C la somme de toutes les valeurs. Ex : D2:Q10​

L'idée est de lancer chaque semaine la macro pour capter toutes les infos de la semaine précédente.
Donc les deux variables sont le nom de la feuille suivant le numéro de semaine et la zone de sélection.
Pour cette dernière il est possible de sélectionner D3:Q3 puis de descendre jusqu'en bas avec un Selection.End(xlToDown) peut être.

Je m'embrouille dans les boucles et mes connaissances limitées en VBA ne me permettent pas de réaliser tout ça.
Un peu d'aide serait le bienvenu

Merci à vous,
Shu

 

[xUpsilon]

Bizarre, as-tu entré la bonne semaine dans l'Input ? Est-ce que la feuille de tes documents est nommée avec la même semaine ?

 

[ShuarS]

Oui oui bien sûr.
J'ai vérifié plusieurs fois.
J'ai aussi essayé de supprimer les espaces.
Toujours la même erreur

 

[xUpsilon]

Bizarre je n'ai pas de souci de mon problème.
En essayant de sortir cette erreur j'ai réussi à l'avoir en ayant trop de classeurs ouverts. Est-ce que consolide est le seul classeur ouvert lorsque tu lances la macro ?

 

[ShuarS]

Oui j'ai même vérifié dans mes processus pour être sûr.
J'ai aussi affecté la macro sur le bouton 1 pour fermer VB.
J'ai donc uniquement le classeur "consolide" ouvert, le clic sur le bouton 1, je rentre le nom de la feuille recherché càd "2019 Sem 50" puis OK.
Tous les classeurs ont bien leur feuille nommée "2019 Sem 50".

Résultat :
Le nom du premier classeur est bien ramené en A1 sur classeur "consolide";
Le nom de la feuille est bien ramené en B1 "2019 Sem 50";
Plantage de la macro sur Erreur d'exécution 9 sur la ligne :

Somme = WorksheetFunction.Sum(Workbooks(2).Worksheets(Semaine).Range("D3:H100"))

Code complet :

Sub BoucleFichiers()
    Dim Chemin As String, Fichier As String, i As Integer, Semaine As String
        
    i = 1
    Semaine = InputBox("Quel est le mois de l'année ? (format aaaa Sem ss)")
    Chemin = "C:\test\a\"
    Fichier = Dir(Chemin & "*.xlsm")
    Do While Len(Fichier) > 0
        Workbooks.Open (Chemin & Fichier)
        Workbooks("consolide.xlsm").Worksheets(1).Range("A" & i) = Fichier
        Workbooks("consolide.xlsm").Worksheets(1).Range("B" & i) = Semaine
        Somme = WorksheetFunction.Sum(Workbooks(2).Worksheets(Semaine).Range("D3:H100"))
        Workbooks("consolide.xlsm").Worksheets(1).Range("C" & i) = Somme
        Workbooks(2).Close
        i = i + 1
        Debug.Print Chemin & Fichier
        Fichier = Dir()
    Loop
End Sub

 

[xUpsilon]

Somme semble ne pas avoir été déclaré en variable ici (je pense pas que ce soit la source du problème mais bon).
Sinon je t'avoue que je ne comprends pas. Si tu mets Workbooks(Fichier) à la place de Workbooks(2) ça donne quoi ?
La plage de sommation est la bonne ? (D3:H100)

Je continue de chercher

 

[ShuarS]

Je déclare Somme :

'Exemple : nombre à virgule
Dim nbVirgule As Single
nbVirgule = 123.45

Je remplace Workbooks(2) par Workbooks(Fichier) OK.

Le résultat arrive !

Par contre en effet tu as raison : c'est long ^^
Ne serait il pas possible de récupérer la valeur somme sans ouvrir le classeur ?

Merci pour ton aide c'est sympa

 

[xUpsilon]

Re,

Il existe une solution pour lire des données sans ouvrir le classeur en question. A vrai dire je ne m'y connais pas trop et je ne l'ai jamais utilisé donc je ne saurais pas t'en dire plus mais voici un lien exemple ici.

Bonne continuation

 

[ShuarS]

Je regarderai merci
J'ai optimisé tout ça avec les clés classiques. Le résultat est très satisfaisant !
Voilà le code complet :

Sub BoucleFichiers()
    Dim Chemin As String, Fichier As String, i As Integer, Semaine As String, Somme As Single
    Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
    Dim iCalcul As Integer

    ' On conserve d'abord les configurations existantes

BoEcran = Application.ScreenUpdating
BoBarre = Application.DisplayStatusBar
iCalcul = Application.Calculation
BoEvent = Application.EnableEvents
BoSaut = ActiveSheet.DisplayPageBreaks

    ' On force les configurations
    
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
    
    i = 1
    Semaine = InputBox("Quel est le mois de l'année ? (format aaaa Sem ss)")
    Chemin = "C:\test\a\"
    Fichier = Dir(Chemin & "*.xlsm")
    'Fichier = Dir(Chemin & "*.*")
 
    Do While Len(Fichier) > 0

        Workbooks.Open (Chemin & Fichier)
        Workbooks("consolide.xlsm").Worksheets(1).Range("A" & i) = Fichier
        Workbooks("consolide.xlsm").Worksheets(1).Range("B" & i) = Semaine
        Somme = WorksheetFunction.Sum(Workbooks(Fichier).Worksheets(Semaine).Range("D3:H100"))
        Workbooks("consolide.xlsm").Worksheets(1).Range("C" & i) = Somme
        Workbooks(Fichier).Close
        i = i + 1
        Debug.Print Chemin & Fichier
        Fichier = Dir()
        
    Loop

        ' Restauration des configurations

Application.ScreenUpdating = BoEcran
Application.DisplayStatusBar = BoBarre
Application.Calculation = iCalcul
Application.EnableEvents = BoEvent
ActiveSheet.DisplayPageBreaks = BoSaut

End Sub

Bonne continuation à toi aussi

 

[Amilo]

Bonjour ShuarS, xUpsilon, Chrus

Bonjour @Amilo , merci. Votre solution serait elle complexe ?
J'attends un peu d'aide pour corriger l'erreur et je vais essayer de traiter mon besoin avec VB.
Mais j'utilise Office 365, je possède donc Power Query.

Bonjour ShuarS, xUpsilon, chris , le forum,
La solution Power query n'est pas complexe, Power query est prévu pour ce genre d'opérations : consolidation, transformation, fusion...et plein d'autres...etc
Je vous mettrai la solution en vidéo pour les manipulations mais certainement ce soir après 21h.

Cordialement

 

[ShuarS]

@Amilo , merci je suis preneur

 

[Amilo]

Re,
@ShuarS , comme convenu ci-dessous le lien pour la vidéo,
Video ShuarS
J'ai pris en exemple 2 fichiers pour la consolidation mais s'il y en avait 100 c'était pareil,
Sinon, je ne sais pas si chacun de vos fichiers comportent un onglet par semaine sinon je suis parti dans cette optique mais ça ne changerait rien dans les manipulations si vous avez qu'un seul onglet par fichier.
A savoir aussi, si vous avez d'autres fichiers qui se trouvent dans le même dossier ou voire des onglets qui ne doivent pas être consolidés, il faudra alors affiner les filtres.
Peut être qu'avec la vidéo vous devriez être en mesure d'ajouter de nouveaux critères dans les filtres pour exclure éventuellement des fichiers non souhaités du dossiers.

Edit : je n’ai pas eu le temps de lire et de suivre l’ensemble du fil pour m’assurer que le résultat de ma vidéo est celui que vous souhaitiez. Si vous ne désirez pas voir les extensions des fichiers .xlsm dans la colonne, il est facile d’ajouter une étape en fractionnant cette colonne dans le ruban « Transformer » puis « Fractionner la colonne » dans Power query.

Cordialement

 

[ShuarS]

Bonjour @Amilo ,
Merci bcp pour cette vidéo personnalisée !
Power Query semble très puissant.
Je vais essayer de reproduire vos manipulations.

Je reviendrais ici pour vous partager mon avis.

Bonne journée,
Shu