Somme de 2 cellules de plusieurs fichiers.

**MANOU06** · 09/04/2017, 10h03

Bonjour,
J'ai X fichiers de même structure dans un répertoire "TOTO" et je voudrais avoir la sommes de toutes les cellules A1 et B1 de tous mes fichiers (dans un autre fichier). Pouvez vous m'aider a trouver la solution SVP.
Par avance grand merci

**RyuAutodidacte** · 09/04/2017, 11h51

Bonjour,

Se servir de ce lien (en consultant la faq on trouve plein de réponses appropriées) :
• Comment boucler sur les fichiers d'un répertoire ?

Dans la Boucle :
• Comment ouvrir un classeur ?

• Faire tes actions d'Addition sur le classeur de destination en prenant les valeurs des fichiers sources

puis une fois fini avec un classeur source avant de passer au suivant :
• Comment fermer un classeur sans enregistrer les changements ?

il faudra au préalable déclarer une première fois la variable du classeur de destination
et dans la boucle déclarer la variable du classeur source à chaque passage d'une nouvelle ouverture dans la boucle (se sera la même variable)

Ne pas oublier le pointage : Classeur.Feuille.plage
ex. avec le classeur source en utilisant sa variable (à créer 1 fois dans la boucle au bon emplacement - ex : wbSource (on peut donner le nom que l'on veut)) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

wbSource.Sheets("NomDeMaFeuille").Range("A1").Value

une fois fini à la fin du code il faudra détruire les variables du classeurs de destination et du classeur source

je te laisse faire tes propres recherches pour le reste …

voilà

**Marc-L** · 09/04/2017, 13h34

Bonjour !

Envoyé par MANOU06

J'ai X fichiers de même structure

Combien de fichiers ?‼

Car plus le nombre est important plus la solution classique sera longue à l'exécution !

Rappel : la qualité d'une solution proposée dépendant de celle de la présentation initiale …

___________________________________________________________________________________________________________
Je suis Paris, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**MANOU06** · 09/04/2017, 13h45

Bonjour,
Merci pour ta réponse... j'ai déjà utilisé les liens que tu préconises et je n'ai pas de problème pour additionner une somme sur une cellule la A1 par exemple mais je n'arrive pas à avoir 2 (ou plus) de compteur. J'y arrive en refaisant la boucle, mais c'est très lourd et je pense qu'il y a une manière plus "orthodoxe" de le faire. Voici le code que j'utilise

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Sub SOMME_TGC()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
If objFolder Is Nothing Then
    MsgBox "Arret de la macro", vbCritical, "Annulation"
Else
    'On renseigne le compteur à 0
    compteur = 0
    'Sélection du répertoire
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
 
    'format du fichier (par exemple xlsx)
    fichier = Dir(Chemin & "*.xlsx")
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
            'on va coller le résultat dans la feuille 2
            With Sheets("Feuil2")
                .[A1] = "=Plage"
                'on ajoute le résultat trouvé dans le compteur
                compteur = compteur + .[A1].Value
 
            End With
        End If
 
        fichier = Dir()
    Loop
End If
 
'On colle le compteur dans la cellule B2
Range("B2").Select
ActiveCell.Value = compteur
 
 
 
If objFolder Is Nothing Then
    MsgBox "Arret de la macro", vbCritical, "Annulation"
Else
    'On renseigne le compteur à 0
    compteur2 = 0
    'Sélection du répertoire
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
 
    'format du fichier (par exemple xlsx)
    fichier2 = Dir(Chemin & "*.xlsx")
    Do While Len(fichier2) > 0
        If fichier2 <> ThisWorkbook.Name Then
            'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
            ThisWorkbook.Names.Add "Plage2", _
            RefersTo:="='" & Chemin & "[" & fichier2 & "]Feuil1'!$B$1"
            'on va coller le résultat dans la feuille 2
            With Sheets("Feuil2")
                .[B1] = "=Plage2"
                'on ajoute le résultat trouvé dans le compteur
                compteur2 = compteur2 + .[B1].Value
 
            End With
        End If
 
        fichier2 = Dir()
    Loop
End If
 
'On colle le compteur dans la cellule B2
Range("D2").Select
ActiveCell.Value = compteur2
End Sub

**MANOU06** · 09/04/2017, 14h02

Bonjour Marc,

J'ai beaucoup de fichiers, et ils évoluent.
En tout, il me faudrait 5 ou 6 compteurs ! et le code que j'ai fait ne me satisfait pas... (il est sur le poste plus haut

)
Y a t-il un moyen plus simple d'y arriver ?

**Marc-L** · 09/04/2017, 15h35

« Beaucoup » c'est vague tout comme « ils évoluent » !
Et maintenant évoquer cinq / six compteurs alors que dans la présentation initiale il n'y a que deux cellules à additionner !

Encore une fois, une présentation claire et exhaustive est impérative afin de proposer une solution optimale.
Sinon on en restera là avec ton code et tout son inutile …

Pour les compteurs, une possibilité via une variable tableau …

**MANOU06** · 10/04/2017, 03h59

Envoyé par Marc-L

« Beaucoup » c'est vague tout comme « ils évoluent » !

"Beaucoup" : de 1 a XXX
et ils "évoluent" : le nombre de fichiers augmentent de 1 a XXXX

Ma demande est la suivante : comment avoir un fichier qui regroupe plusieurs compteurs de totalisation (somme de toutes les cellules A1 - B10 - J40 et C3 de la feuille1 de tous les fichiers qui se trouvent dans le répertoire TOTO)

Voilà , j'espère que c'est plus claire

Merci de l'aide.

PS: J'habite en Nouvelle Calédonie, il y a un gros décalage horaire ; c'est pour cela que je n'ai pas répondu tout de suite. (et en plus on est en alerte cyclonique

)

**RyuAutodidacte** · 10/04/2017, 04h13

bonsoir,

la demande vient de changer par rapport à la demande initial !
comme le suggère @Marc-L utilisation d'une variable tableau pour regrouper les différentes sommes et on pourrait faire en plus la lecture des fichiers en fichier fermé
ça pourrait être une solution à envisager

Edit : Voilà ce que cela peut donner en lecture fichier fermé

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
Sub SommeCellules()
    Dim Chemin As String, Fichier As String, Feuille As String, Somme(), Cellules, i As Byte, V As String, AddCel
 
    Chemin = "MettreLeCheminDuDossierVoulu"
 
    Feuille = "Feuil1": Cellules = Array("A1", "B10", "C3", "J40")
    ReDim Somme(LBound(Cellules) To UBound(Cellules))
    For i = LBound(Cellules) To UBound(Cellules): Somme(i) = Range(Cellules(i)): Next
 
   Fichier = Dir(Chemin & "*.xlsx")
 
    Do While Len(Fichier) > 0
                For i = LBound(Cellules) To UBound(Cellules)
                    V = "'" & Chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellules(i)).Address(, , xlR1C1)
                    AddCel = Application.ExecuteExcel4Macro(V)
                    Somme(i) = Somme(i) + AddCel
                Next
        Fichier = Dir()
    Loop
    For i = LBound(Somme) To UBound(Somme): Range(Cellules(i)) = Somme(i): Next
End Sub

Edit : Alors est ce Ok ?

Edit 2 : Dans le cas où il y a des chiffes qui sont au format texte dans les fichiers il faudra faire une conversion

**MANOU06** · 11/04/2017, 03h15

Bonjour RyuAutodidacte,

J'ai modifié le code pour choisir le répertoire, voici ce que j'ai fait :

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
 
Sub SommeCellules()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, Fichier As String, Feuille As String, Somme(), Cellules, i As Byte, V As String, AddCel
Dim compteur As String
 
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
   'Dim Chemin As String, Fichier As String, Feuille As String, Somme(), Cellules, i As Byte, V As String, AddCel
   'Chemin = "MettreLeCheminDuDossierVoulu"
 
 
    Feuille = "Feuil1": Cellules = Array("k49", "K50", "L49", "L50")
    ReDim Somme(LBound(Cellules) To UBound(Cellules))
    For i = LBound(Cellules) To UBound(Cellules): Somme(i) = Range(Cellules(i)): Next
 
   Fichier = Dir(Chemin & "*.xlsx")
 
    Do While Len(Fichier) > 0
                For i = LBound(Cellules) To UBound(Cellules)
                    V = "'" & Chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellules(i)).Address(, , xlR1C1)
                    AddCel = Application.ExecuteExcel4Macro(V)
                    Somme(i) = Somme(i) + AddCel
                Next
        Fichier = Dir()
    Loop
    For i = LBound(Somme) To UBound(Somme): Range(Cellules(i)) = Somme(i): Next
End Sub

j'ai une erreur "incompatibilité de type" sur la ligne : Somme(i) = Somme(i) + AddCel
et je ne sais pas réparer

Les cellules a additionner sont des nombres puisque ce sont des formules par exemple la "k49" = k17*k2

Excuse moi pour les réponses tardives, mais comme je l'ai dit nous avons 10h de décalage horaire et en plus, suite au cyclone nous n'avons pas de courant depuis hier APM, nous fonctionnons sur le groupe électrogène et nous ne le branchons pas en continu.

En tous cas je te remercie pour ton aide

**RyuAutodidacte** · 11/04/2017, 05h02

Bonjour,

Voilà le code corrigé :

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
Sub SommeCellules()
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String, Fichier As String, Feuille As String, Somme(), Cellules, i As Byte, V As String, AddCel
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path & "\"
    If Chemin = "" Then Exit Sub
 
    Feuille = "Feuil1": Cellules = Array("K49", "K50", "L49", "L50")
    ReDim Somme(LBound(Cellules) To UBound(Cellules))
    For i = LBound(Cellules) To UBound(Cellules): Somme(i) = CDbl(Range(Cellules(i))): Next
 
   Fichier = Dir(Chemin & "*.xlsx")
 
    Do While Len(Fichier) > 0
                For i = LBound(Cellules) To UBound(Cellules)
                    V = "'" & Chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellules(i)).Address(, , xlR1C1)
                    AddCel = Application.ExecuteExcel4Macro(V)
                    Somme(i) = CDbl(Somme(i)) + CDbl(AddCel)
                Next
        Fichier = Dir()
    Loop
    For i = LBound(Somme) To UBound(Somme): Range(Cellules(i)) = Somme(i): Next
End Sub

**MANOU06** · 11/04/2017, 08h19

RyuAutodidacte
hou la la
Vous vous levez super tôt

Merci pour le code.

Voilà le résultat des tests :

J’ai créé 2 répertoires ; 1 nommer « TEST » et l’autre nommé « TEST1 »
Dans le répertoire TEST j’ai créé 4 fichiers en ne remplissant que les cellules K49=1 L49=2 K50=3 L50=4 pour les 4 fichiers et dans ce cas tout va bien, la macro me donne bien au K49=4 L49=8 K50=12 et L50=16
Dans le répertoire TEST 1 j’ai mis mes fichiers de travail et là, ça ne fonctionne plus la macro additionne 2023 fois autant de feuille dans le répertoire et ce même si je rempli les cellules K49 L49 k50 L50 avec zero et en supprimant toutes les autres cellules. Je ne sais pas où elle va chercher ces 2023.
Ah ! Et si j’intègre un de ces fichier de travail (vide sauf zéro ds les cellules concernées) dans le répertoire TEST elle calcule tjrs bien les 4 fichiers initiaux et elle rajoute 2023 ; le résultat final :
K49=1+2023 L49=2+2023 K50=12+2023 L50=16+2023
Je ne comprends pas ce qu’il se passe…
Est-il possible de remettre les cellules à zéro au départ de la macro
J’espère que ce que j’ai écrit n’est pas trop charabia !
Là, je dois couper le groupe car autrement nous n’aurons pas d’électricité ce soir, les stations sont à sec et il ne nous reste plus beaucoup d’essence.
Encore une fois grand merci

**RyuAutodidacte** · 12/04/2017, 02h16

Bonsoir,

très bizarre comme comportement surtout que 2023 correspond à une erreur.
Par contre pour ma part il est difficile de dire d'ou cela peut provenir sans être dans la même situation de test,
étant donné que je n'ai pu le reproduire.
La seule chose qui me vienne à l'esprit pour l'instant, ça serait le nom de feuille qui ne serait pas correct => Dans mon code Feuille = "Feuil1" …

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Feuille = "Feuil1": Cellules = Array("K49", "K50", "L49", "L50")

Les feuilles dans les classeurs se trouvant dans « TEST1 » se nomment elles bien ainsi : "Feuil1" ??
Y a t'il dans les noms (classeurs, chemin,feuilles) des caractères spéciaux comme "'", "*", ect … ??

sinon joindre les fameux classeur posant problème en enlevant les données sensibles/privées

**MANOU06** · 12/04/2017, 07h44

Bonjour RyuAutodidacte,

Ça marche super ! c’était bien ça, le nom de la feuille n’était pas le même ! quelle cruche !

Çà va beaucoup m'aider pour mes contrôles de taxe

Si tu as le temps et si tu veux encore m'aider , j'aurais encore une autre demande

...

En tout cas grand merci pour tout

Somme de 2 cellules de plusieurs fichiers. [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager