Somme d'une même cellule de plusieurs fichiers

Bonjour a tous,

j'ai besoin de pouvoir faire une somme d'une même cellule contenue dans plusieurs fichiers (je dis bien fichiers et non pas feuilles) qui sont eux même dans un même répertoire. Une macro doit donc me demander, via une boite de dialogue, quel répertoire est concerné puis dans tous les fichiers (.xlsx) de ce répertoire, aller cherché la valeur d'une cellule (ex D7), toutes les additionnées et me donner le résultat dans un autre fichier (qui contiendra la macro) en cellule B2 (par ex).

Les fichiers qui sont ouverts doivent l' être en mode caché si possible et être refermés aussitôt sans demande d'enregistrement.

Je sais que c'est possible, mais je ne suis pas suffisamment calé en VBA pour y arrivé seul

J'espère qu'un passionné pourra m'aider.......merci.

D'avance merci

Philippe

Bonsoir Philippe, bonsoir le forum,

Quel est le nom de l'onglet des fichiers sources (en espérant qu'ils aient tous le même) ?

Bonsoir,

Ils s"appellent tous "feuil1", tout simplement, je ne renomme pas nécessairement ces feuilles.

Bonsoir Philippe, bonsoir le forum,

Essaie le code ci-dessous à adapter (peut-être) :

Private Sub CommandButton1_Click() 'bouton "Somme"
Dim CO As Workbook 'déclare la variable CO (Classeur Original)
Dim OO As Object 'déclare la variable OO (Onglet Original)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim OD As FileDialog 'déclare la variable OD (boîte Ouvrir Dossier)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim DT As Object 'déclare la variable DT (Dossier de Travail)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim SO As Double 'déclare la variable SO (SOmme)

ActiveCell.Select 'enlève le focus au bouton
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CO = ThisWorkbook 'définit le classeur original CO
Set OO = CO.Sheets("Feuil1") 'définit l'onglet original OO (à adapter)
Set DEST = OO.Range("B2") 'définit la cellule de destination DEST (à adapter)
Set OD = Application.FileDialog(msoFileDialogFolderPicker) 'définit la boîte de dialogue OD
deb: 'étiquette
With OD 'prend en compte la boite de dialogue OD
    If .Show = -1 Then 'condition : si bouton [OK} de la boîte de dialogue OD
        CH = OD.SelectedItems(1) 'récupère le chemin complet du dossier choisi
    Else 'si bouton [Annuler] ou fermeture sans choix
        'message et retour à la boîte de dialogue via l'étiquette "deb"
        MsgBox "Vous devez sélectionner un dossier et valider !": GoTo deb
    End If 'fin de la condition
End With 'fin de la prise en compte de la boîte de dialogue OD
Set OD = Nothing 'vide de la mémoire l'objet OD
'si aucun dossier n'a été sélectionné, message, sort de la procédure
If CH = "" Then MsgBox "La Somme est abandonée !":  Exit Sub
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
Set DT = SF.GetFolder(CH) 'définit le dossier de travail DT
Set FS = DT.Files 'définit l'ensembles des fichiers du dossier de travail DT
For Each F In FS 'boucle sur tous les fichiers F de l'ensemble FS
    If UCase(Right(F.Name, 5)) = ".XLSX" Then 'condition : si le fichier à une extension ".xlsx"
        Workbooks.Open (F) 'ouvre le fichier
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
        SO = SO + OS.Range("D7").Value 'définit la somme SO
        CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
Next F 'prochain fichier de la boucle
DEST.Value = SO 'place la somme dans la celllule DEST
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Bonsoir,

Génial, ca a l'air de fonctionner !! merci beaucoup.

j'approfondi ca demain et je reviens vers toi si besoin. En tout cas merci encore pour la rapidité et l'efficacité.

Philippe