VBA Réaliser la somme de cellules dans des fichiers différents

yaute Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 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!!! 


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:

1 réponse

Réponse 1 / 1
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

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
0

Discussions similaires

Chemin Logo du site de la Cité de l'espace
Keiios -
blux -

11 réponses