VBA -Un TCD multi feuilles, sans TCD, par macro

VBA -Un TCD multi feuilles, sans TCD, par macro

• Introduction
• Le classeur de base
• Le code VBA
• Téléchargement
• A lire aussi: Vba selection tcd

Introduction

Nous allons voir ici l'utilisation des clés de l'objet « Dictionary » dans une variable tableau à deux dimensions. 
Ca a l'air « barbare », mais en fait, cela permet de créer facilement et rapidement une feuille récapitulative d'un classeur complet. 

Le classeur de base

Soit un classeur des ventes, par mois, vendeurs et produits vendus. 
Dans ce classeur, 12 feuilles, une par mois. 
Dans chacune de ces feuilles, trois colonnes sont complétées : 
- Colonne A : les noms des vendeurs, 
- Colonne B : les noms des produits vendus, 
- Colonne C : la quantité. 

Le code VBA

Pour l'intégrer à votre classeur, copiez tout le code ci-dessous, ALT+F11, Insertion/Modules, y coller le code. Pour l'utiliser, fermer la fenêtre Visual Basic Editor pour revenir dans votre classeur, puis : ALT+F8, choisir "RécapAvecSommeDesColonnesC" puis cliquer sur "Exécuter". 
A adapter : 
- le nom de la feuille de récap ("Récap" dans l'exemple) 
- les colonnes "sources" des données, A, B et C dans l'exemple 

• MSI Wind U90 U100 U90X U100X Advent 4211 black battery‍

Option Explicit  

Sub RécapAvecSommeDesColonnesC()  
Dim Feuille As Worksheet, i As Long  
Dim TablVendeurs(), DicoVendeurs As Object  
Dim TablVentes(), DicoVentes As Object  
Dim Sommes()  

Set DicoVendeurs = CreateObjectCompal batteries

COMPAQ batteries‍("Scripting.Dictionary")  
Set DicoVentes = CreateObject("Scripting.Dictionary")  

'*******REMPLISSAGE DES OBJETS DITIONARY ET VARIABLES*******  

'remplissage des étiquettes de lignes et de colonnes sans doublons  
For Each Feuille In ThisWorkbook.Worksheets  
    If Feuille.Name <> "Récap" Then  
        With Feuille  
            TablVendeurs = .Range("A2", .Range("A" & Rows.Count).End(xlUp))  
            For i = LBound(TablVendeurs, 1) To UBound(TablVendeurs, 1)  
                If Not DicoVendeurs.exists(TablVendeurs(i, 1)) Then DicoVendeurs.Add TablVendeurs(i, 1), TablVendeurs(i, 1)  
            Next i  
            TablVentes = .Range("B2", .Range("B" & Rows.Count).End(xlUp))  
            For i = LBound(TablVentes, 1) To UBound(TablVentes, 1)  
                If Not DicoVentes.exists(TablVentes(i, 1)) Then DicoVentes.Add TablVentes(i, 1), TablVentes(i, 1)  
            Next i  
        End With  
    End If  
Next Feuille  
'remplissage de la variable tableau 2D grâce aux clés de Dictionary  
ReDim Sommes(1 To DicoVendeurs.Count, 1 To DicoVentes.Count)  
For Each Feuille In ThisWorkbook.Worksheets  
    If Feuille.Name <> "Récap" Then  
        With Feuille  
            For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row  
                Sommes(Application.Match(.Cells(i, 1), DicoVendeurs.keys, 0), Application.Match(.Cells(i, 2), DicoVentes.keys, 0)) = Sommes(Application.Match(.Cells(i, 1), DicoVendeurs.keys, 0), Application.Match(.Cells(i, 2), DicoVentes.keys, 0)) + .Range("C" & i).Value  
            Next i  
        End With  
    End If  
Next Feuille  

'*******RESTITUTION DES DONNEES*******  

With Sheets("Récap")  
    .Range("A2").Resize(DicoVendeurs.Count, 1) = Application.Transpose(DicoVendeurs.keys)  
    .Range("B1").Resize(1, DicoVentes.Count) = DicoVentes.keys  
    .Range("B2").Resize(UBound(Sommes, 1), UBound(Sommes, 2)) = Sommes()  
End With  
End Sub

Téléchargement

Vous pouvez télécharger 
- le classeur source exemple format .xlsm (Excel > 2007) - 1,19 Mo 
- le classeur source exemple format .xls (Excel < 2007) - 3,86 Mo 

Si toutefois ils n'étaient plus disponible sur cjoint, merci de me le faire savoir en m'envoyant un MP ici, cliquez sur « Lui écrire un message »‍