XL 2013 Comment réaliser par VBA un récapitulatif avec somme des valeurs issues de plusieurs feuilles de calculs

[gamomchristian]

Bonjour à tous,
Je voudrais effectuer une recherche de noms dans plusieurs feuilles et totaliser les montants correspondant à ces noms dans la feuille récapitulatif
La feuille récap peut être mise à jour lorsqu'une nouvelle feuille de données est ajoutée.
Les lignes de la feuille récap doivent être crées automatiquement en fonctions des noms qui sont trouvés dans les feuilles de données

le fichier joint donne un exemple des feuilles à traiter, seul les feuilles dont le nom commence par s sont concernés pour effectuer le recap

Je vous remercie d'avance de me donner quelques tuyaux

 

[job75]

Bonjour gamonchristian, bienvenue sur XLD,

Placez cette macro dans le code de la feuille "recap" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim d As Object, w As Worksheet, colnom As Variant, colmontant As Variant, tablo, i&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each w In Worksheets
    If LCase(Left(w.Name, 1)) = "s" Then 'le nom doit commencer par "s"
        colnom = Application.Match("nom*", w.Rows(1), 0)
        colmontant = Application.Match("montant*", w.Rows(1), 0)
        If IsNumeric(colnom) And IsNumeric(colmontant) Then
            With w.Range("A1", w.UsedRange)
                tablo = .Value 'matrice, plus rapide
                For i = 1 To UBound(tablo)
                    If tablo(i, colnom) <> "" And IsNumeric(tablo(i, colmontant)) Then _
                        d(tablo(i, colnom)) = d(tablo(i, colnom)) + tablo(i, colmontant)
                Next i
            End With
        End If
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If d.Count Then
        .Cells(1, 2).Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
        .Cells(1, 3).Resize(d.Count) = Application.Transpose(d.items)
        .Cells(1, 2).Resize(d.Count, 2).Sort .Cells(1, 2), xlAscending, Header:=xlNo 'tri
        .Cells(1) = 1: .Resize(d.Count).DataSeries 'numérotation
    End If
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle se déclenche quand on active la feuille.

L'exécution est rapide car on utilise des tableaux VBA et le Dictionary.

A+

 

[gamomchristian]

Bonjour Job75
je l'ai testé et ça marche très bien.

!!! solution parfaite !!!

Merci beaucoup