Somme des cellules de plusieurs fichiers Excel

Bonjour,

Je ne sais pas si votre problème est toujours d'actualité. Je vous donne une proto-solution, ne l'ayant pas testée compte tenu du problème, ne sachant si elle correspondra à votre attente de sommer toutes les cellules (choses ardues, notamment si certaines contiennent du texte par exemple).

Il faudra bien entendu que vous adaptiez avec vos chemin (répertoire des dossiers) et nom de fichier.

Pour info, j'ai considéré que vous aviez un dossier dans lequel se trouverait votre fichier global ainsi qu'une multitude de sous-dossiers contenant les fichiers, supposés d'un unique nom identique (si ce n'est pas le cas, je pourrai trouver une alternative à condition de mettre tous les fichiers à sommer dans un même sous-dossier).

J'ai également supposé, n'ayant pas d'informations à disposition, que vous aviez sur chaque onglet (de chaque classeur), une seule plage continue de valeurs. Si ce n'était pas le cas, il faudrait éventuellement définir manuellement une plage commune à chaque onglet sur laquelle travailler.

Si vous souhaitez tester, je vous recommande de le faire au début avec seulement 2 fichiers, car je n'ai pas idée du temps que ça pourrait prendre.

Voici le code (2 macros, dont l'une - recherche et ouverture des fichiers - qui appelle l'autre - copier les valeurs dans le classeur de destination) :

Sub FichierGlobal()

'------------------------------------------------------------------------------
'MACRO PRINCIPALE : RECHERCHE LES FICHIERS DANS LES SOUS-DOSSIERS ET EXECUTE LA MACRO COPIERCOLLER
'------------------------------------------------------------------------------

Dim NomFichier$ 'nom du fichier sur lequel se trouve l'onglet à récupérer
Dim Dossier$ 'Répertoire de base
Dim SousDossier$ 'Variable string pour sous-répertoires
Dim Chemin$ 'Variable chemin complet des fichiers des sous-rep
Dim Cible$ 'Variable nom fichier dans sous-rep
Dim Reprise$ 'Variable tampon pour reprendre après sous-rep déjà traité
Dim WbCible As Workbook 'Variable classeur à récupérer

NomFichier = "Nomdesvosfichiers.xlsm" 'considéré identique
Dossier = ThisWorkbook.Path & "\" 'EMPLACEMENT DU FICHIER EN COURS ET DES SOUS-DOSSIERS CONTENANT LES FICHIERS A GLOBALISER

SousDossier = Dir(Dossier, vbDirectory)  'Renvoie nom des fichiers et sous rep de Dossier (à cette ligne, renvoie le 1er. Renverra les suivants à chaque SousDossier = Dir >> voir fin de boucle)

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'PARCOURT LES FICHIERS ET SOUS DOSSIERS DU DOSSIER RACINE

While SousDossier <> ""  'tant que SousDossier n'est pas vide <> tant qu'il existe des fichiers dans le dossier destination

    If (GetAttr(Dossier & SousDossier) And vbDirectory) <> 0 Then 'si SousDossier en cours est un répertoire

'------------------------------------------------------------------------------
'-----EN CAS DE SOUS DOSSIER DETECTE

        Chemin = Dossier & SousDossier & "\" & NomFichier 'affectation nom du chemin complet
        Cible = Dir(Dossier & SousDossier & "\")  'Renvoie le nom du fichier en cours du sous rep

        '------------------------------------------------------------------------------
        '-----PARCOURT LES FICHIERS DE CE SOUS DOSSIER

        Do While Cible <> "" 'tant qu'il existe des fichiers dans ce sous rep

        '------------------------------------------------------------------------------
        '-----SI LE FICHIER CHERCHE EST TROUVE

            If Cible = NomFichier Then  'si ce fichier a pour valeur le nom du fichier cherché

                Workbooks.Open Chemin 'Ouverture de ce fichier (classeur excel en l'ocurrence) - RQ : celui-ci devient le classeur actif
                Set WbCible = ActiveWorkbook 'Affectation Objet Workbook (pour distinguer du classeur global)
                Call CopierColler(WbCible) 'Exécution de la macro COPIER COLLER
                WbCible.Close savechanges:=True 'fermeture avec sauvegarde du classeur ancien
                Set WbCible = Nothing 'libération de la variable workbook
                Exit Do 'sortie du sous-dossier

            End If

        '------------------------------------------------------------------------------
        '-----TANT QU'IL N'EST PAS ATTEINT, ON CONTINUE

            Cible = Dir  'ON PASSE AU FICHIER SUIVANT DU SOUS-REP EN COURS

        Loop

'------------------------------------------------------------------------------
'-----A LA SORTIE D'UN SOUS-DOSSIER, ON REITERE L'OPERATION DE RECHERCHE D'UN SOUS-DOSSIER

    Reprise = Dir(Dossier, vbDirectory) 'RETOUR AU DOSSIER DE BASE QUAND L'ANALYSE DU SOUS DOSSIER EST FINIE

    While Reprise <> SousDossier 'TANT QUE FICHIER EN COURS <> DU SOUS-REP AUQUEL ON SEST ARRETE
        Reprise = Dir 'ON REPARCOURT TOUS LES FICHIERS DU DOSSIER (POUR EVITER DE COPIER INDEFINIMENT LE MEME FICHIER)
    Wend

    End If

'------------------------------------------------------------------------------
'-----TANT QU'IL RESTE DES FICHIERS OU SOUS-DOSSIER

SousDossier = Dir 'ON PASSE AU FICHIER SUIVANT DU REP DE BASE

Wend

End Sub

Sub CopierColler(WB As Workbook)

'------------------------------------------------------------------------------
'MACRO POUR IMPORTER LES DONNEES D'UN CLASSEUR ACTIF DANS NOTRE CLASSEUR DE TRAVAIL
'------------------------------------------------------------------------------

Dim Ws As Worksheet 'variable feuille
Dim plage As Range, cell As Range, Destination As Range 'variable plage, cellule active et cellule de destination
Dim Tampon As Double 'variable numérique servant de réservoir temporaire

For Each Ws In WB.Worksheets 'pour chaque feuille du classeur

    IndexF = Ws.Index 'retourne le numéro de la feuille en cours
    Set plage = Ws.Cells(1, 1).CurrentRegion 'définit la plage sur laquelle on opérera

    For Each cell In plage 'pour chaque cellule de cette plage
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
    ' CAS 1 : la cellule est vide - on passe directement à la cellule suivante
        If cell.Value = "" Then GoTo Suivant
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
    'CAS 2 : la cellule n'est pas vide
        Set Destination = ThisWorkbook.Sheets(IndexF).Range(cell.Address) 'on définit notre cellule de destination (même cellule de la même feuille, mais de notre classeur de travail)
'------------------------------------------------------------------------------
    '1) Si la cellule de destination est vide, celle-ci prend la valeur de la cellule active, quelqu'elle soit
        If Destination.Value = "" Then
            Destination.Value = cell.Value
        Else:
'------------------------------------------------------------------------------
    '2) Si la destination est déjà remplie
    '>> alors on ne la modifie que si elle contient une valeur numérique (date et texte sont ignorés)
            If IsNumeric(cell.Value) Then
                Tampon = Destination.Value 'Variable tampon stocke la valeur initiale en Destination
                Destination.Value = Tampon + cell.Value 'La destination devient sa valeur initiale + la valeur de la cellule active
            End If
        End If
Suivant:
    Next cell 'prochaine cellule
Next Ws 'prochaine feuille

End Sub

Il y a le principe après il n'est pas exclut qu'il faille apporter des corrections. Au moins, vous avez la logique à suivre, avec les instructions utiles et un modèle réadaptables.

Cordialement,