Consolidation en vba de 2 feuilles de 3 colonnes

[SLIM1255]

Salut!
En rajoutant une colonne au fichier ; celle-ci n'est pas affichée en feuil 3 consolidée ? qu'elles modifications apportées au code
et Merci d'avance ! ci- joint fichier modifié avec 3 colonnes

 

[job75]

Bonjour SLIM1255,

Il y a de nombreux exemples de consolidations sur ce forum.

Voyez cette macro dans le code de la feuille "Consolidation" du fichier joint :

Private Sub Worksheet_Activate()
Dim d As Object, w As Worksheet, tablo, i&, x$, a, b, c(), s
Set d = CreateObject("Scripting.Dictionary")
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            If Not UCase(tablo(i, 2)) Like "*TOTAL*" Then
                x = tablo(i, 1) & Chr(1) & tablo(i, 2)
                d(x) = d(x) + Val(Replace(tablo(i, 3), ",", "."))
            End If
        Next i
    End If
Next w
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule de destination, à adapter
    If d.Count Then
        a = d.keys: b = d.items: ReDim c(UBound(a), 2) 'base 0
        For i = 0 To UBound(a)
            s = Split(a(i), Chr(1))
            c(i, 0) = s(0)
            c(i, 1) = s(1)
            c(i, 2) = b(i)
        Next
        .Resize(d.Count, 3) = c
    End If
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
With UsedRange
    .Cells(.Rows.Count + 1, 2) = "TOTAL"
    .Cells(.Rows.Count + 1, 3) = "=SUM(" & .Columns(3).Address(0, 0) & ")"
End With
End Sub

Elle se déclenche quand on active la feuille.

Elle est très rapide car elle utilise le Dictionary et des tableaux VBA.

A+

 

[SLIM1255]

bonjour!
Merci pour la réponse , J'ai rajouté une autre colonne ;mais elle ne s'affiche pas donnez moi une solution et Merci ! code ou qu'elles modification apportées à votre code .............. Bonne soirée !!!! ci_ joint fichier

 

[job75]

Bonjour SLIM1255,

Pour 4 colonnes il faut 2 Dictionary, ci joint le fichier en retour.

A+

 

[SLIM1255]

Merci bien pour les réponses bien précises encore une autre fois ci-joint fichier consolidation et dites -moi que manque-t-il au code pour que la colonne 2 s'affiche Feuil3 ??
Bonne Soirée ...........et encore merci

 

[SLIM1255]

Merci bien pour les réponses bien précises encore une autre fois ci-joint fichier consolidation et dites -moi que manque-t-il au code pour que la colonne 2 des Feuil1 et 2 s'affiche en Feuil3 ??
Bonne Journée...........et encore merci

 

[job75]

Pourquoi ne pas utiliser les solutions qu'on vous donne ???

La macro que j'ai donnée pour 4 colonnes (post #4) va très bien pour le fichier du post #6.

 

[SLIM1255]

Merci , votre macro me convient bien mais la colonne 2 intutulée " cptes " avec ma macro ne s'affiche pas ? que manque- t-il à ma macro ? Bonne Soiréé Toute L'équipe

 

[job75]

La macro que j'ai donnée pour 4 colonnes (post #4) va très bien pour le fichier du post #6.

 

[job75]

Bonjour SLIM1255, le forum,

On peut en effet utiliser en VBA la commande Consolider mais ici il faut d'abord concaténer les 2 premières colonnes :

Private Sub Worksheet_Activate()
Dim w As Worksheet, a$(), n, tablo, i&
Application.ScreenUpdating = False
Range("A1").CurrentRegion.ClearContents 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.Range("A1").CurrentRegion
            ReDim Preserve a(n)
            a(n) = .Address(, , xlR1C1, True) 'liste des adresses sources
            n = n + 1
            tablo = .Resize(, 2)
            For i = 1 To UBound(tablo)
                tablo(i, 1) = tablo(i, 1) & Chr(1) & tablo(i, 2) 'concaténation avec séparateur
            Next i
            .Columns(1) = tablo
            If n = 1 Then Range("A1") = w.Range("A1")
        End With
    End If
Next w
Range("A1").Consolidate Sources:=a, Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False 'commande Consolider
Application.DisplayAlerts = False
For Each w In Worksheets
    w.Columns(1).TextToColumns w.Columns(1), xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
Next w
End Sub

Bonne journée.

 

[SLIM1255]

Merci pour la réponse vite et juste ! Bonne Soirée .