VBA Réaliser la somme de cellules dans des fichiers différents
yaute
Messages postés
1
Statut
Membre
-
f894009 Messages postés 17414 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17414 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai une cinquantaine de fichiers construits exactement de la même façon avec des données. Je souhaiterais les intégrer dans un fichier de synthèse (tableau identique à celui des autres fichiers).
J'arrive à l'aide d'une macro (ci-dessous) à faire la somme d'une cellule dans tous les fichiers mais je n'arrive pas à enchainer pour réaliser la somme des autres cellules contenues dans le tableau. Petite précision : c'est un tableau à 20 colonnes et 18 lignes qu'il faudrait synthétiser.
Est-ce quelqu'un pourrait m'aider à trouver l'astuce ?
Merci d'avance!!!
J'ai une cinquantaine de fichiers construits exactement de la même façon avec des données. Je souhaiterais les intégrer dans un fichier de synthèse (tableau identique à celui des autres fichiers).
J'arrive à l'aide d'une macro (ci-dessous) à faire la somme d'une cellule dans tous les fichiers mais je n'arrive pas à enchainer pour réaliser la somme des autres cellules contenues dans le tableau. Petite précision : c'est un tableau à 20 colonnes et 18 lignes qu'il faudrait synthétiser.
Est-ce quelqu'un pourrait m'aider à trouver l'astuce ?
Merci d'avance!!!
Sub sommescellule()
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&, ThisWorkbook.Path)
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 & "*.xlsm")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est C36 de la feuille 1
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]'xxxxxx'!$C$36"
'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
nbr = nbr + 1
End With
End If
fichier = Dir()
Loop
End If
'On colle le compteur dans la cellule C36
Range("C11").Select
ActiveCell.Value = compteur / nbr
End Sub
| EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages. |
A voir également:
- VBA Réaliser la somme de cellules dans des fichiers différents
- Somme de plusieurs cellules excel - Guide
- Comment réduire la taille d'un fichier - Guide
- Renommer des fichiers en masse - Guide
- Verrouiller des cellules excel - Guide
- Somme si couleur - Guide
1 réponse
Bonjour,
A voir pour adapter la plage, le nom de feuille
A voir pour adapter la plage, le nom de feuille
'base de codage: http://silkyroad.developpez.com/VBA/ClasseursFermes/
'Changement de mode de connexion aux fichiers fermes
Sub Requete_lecture_ClasseurFerme_Excel2007_201x()
Dim objShell As Object, objFolder As Object, Cn As Object, Rst As Object
Dim Chemin As String, Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Table_Cumul(17, 19) As Single 'Tabel de cumul des valeurs
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, ThisWorkbook.Path)
If objFolder Is Nothing Then
MsgBox "Arret de la macro", vbCritical, "Annulation"
Else
'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
'Nom de la feuille dans le classeur fermé
NomFeuille = "FTest"
Set Cn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
'connexion fichier ferme
With Cn
.ConnectionString = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Chemin & Fichier
.Open
End With
'requete SQL pour une plage de cellules
texte_SQL = "SELECT * FROM [" & NomFeuille & "$C35:V40]"
'lecture plage de cellules
Set Rst = CreateObject("ADODB.Recordset")
Set Rst = Cn.Execute(texte_SQL)
'------------Cumul valeurs par cellule----------------
x = 0
'boucle sur les enregistrements a lire
Do While Not Rst.EOF
'boucle sur les champs de l'enregistrement en cours de lecture
For i = 0 To Rst.Fields.Count - 1
Table_Cumul(x, i) = Table_Cumul(x, i) + Rst.Fields(i).Value
Next i
x = x + 1
'avance d'un enregistrement
Rst.Movenext
Loop
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
Set Rst = Nothing
'Classeur suivant
Fichier = Dir()
Loop
'ecriture dans plage feuil1
Worksheets("Feuil1").Range("A1").Resize(18, 20) = Table_Cumul
End If
End Sub
