Bonjour,
Je me trouve dans une problématique où je veux faire la somme d’un nombre inconnu de fichiers Excel ayant un format similaire, chacun contenant plusieurs feuilles, dans le but d’avoir le total des sommes de leurs différentes cellules.
Je ne suis pas un grand chef de la programation sur excel, cependant j'ai trouvé une piste qui me semble bonne dans le code ci-dessous.
Pouriez vous m'éclairer s'il vous plaît ?
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
40
41
 
Sub Macro1()
Dim chem As String 'déclare la variable chem (CHEMin d accès)
Dim fs, d, f1, fd 'déclare les variables fs, d, f1 et fd
Dim cel As Range 'déclare la variable cel (CELlule)
Dim cl As Workbook 'déclare la varaible cl (CLasseur)
Dim t As Double 'déclare la variable t (Total)
 
'***********************
'ouverture des classeurs
'***********************
chem = ThisWorkbook.Path & "C:\Users\A145749\Downloads\New folder" 'définit le chemin
Set fs = CreateObject("Scripting.FileSystemObject") 'définit la variable fs (Fichiers Système)
Set d = fs.GetFolder(chem) 'definit la variable d (dossier)
Set fd = d.Files 'définit la variable fd (Fichiers du Dossier)
For Each f1 In fd 'boucle sur tous les fichier du dossier
   If f1.Name <> "TOTAL.xls" Then Workbooks.Open chem & f1.Name 'ouvre le fichier
Next f1
 
'*****************
'calcul des totaux
'*****************
For Each cel In ThisWorkbook.Sheets("Sheet1").Range("A1:A10") 'boucle 1 : sur toutes les cellules cel de la plage A1:A10 de l'onglet "Feuil1" (tu adapteras le nom de l'onglet si il faut...)
   If cel.Interior.ColorIndex = 38 Then 'condition 1 : si le couleur de fond de la cellule est rose
        For Each cl In Workbooks 'boucle 2 : sur tous les classeurs ouverts
           If cl.Name <> ThisWorkbook.Name Then 'condition 2 : si le nom du classseur est différent du nom de celui-ci
               'redéfinit la variable t si la cellule correspondante est numérique
               If IsNumeric(cl.Sheets("Sheet1").cel.Address) Then t = t + CDbl(cl.Sheets("Sheet1").cel.Address)
            End If 'fin de la condition 2
       Next cl 'prochain classeur de la boucle 2
       cel.Value = t 'place t dans la cellule cel
   End If 'fin de la condition 1
Next cel 'prochaine cellul cel de la boucle 1
 
'***********************
'fermeture des classeurs
'***********************
For Each cl In Workbooks
    If cl.Name <> ThisWorkbook.Name Then cl.Close SaveChanges:=False 'ferme le fichier
Next cl
End Sub
Merci d'avance