[Excel] Fusion de X onglets dans un seul onglet

Bonjour tout le monde

Alors je vous explique l’énoncer de ce que j’aimerais faire !

Au sein d’un fichier Excel j’ai 3 onglets (3 ou plus ce chiffre devra pouvoir être variable ou facilement modifiable si possible) tous formatés de la même façon, à savoir :
-1 colonne avec des références (normalement qui n’apparaît qu’une seul fois par onglet)
-1 colonne quantité (en rapport avec la référence qui est en face)
-1 colonne avec le chiffre d’affaire des ventes (en rapport avec la référence qui est en face)
-1 colonne avec la marge (en rapport avec la référence qui est en face)

J’aimerais d’une façon simple et automatique fusionner ces 3 onglets (ou plus) dans un 4ème onglet formaté de la même façon que ces 3 onglets sauf que je ne veux pas de doublon (au niveau des références) que l’on pourrait retrouver dans les 3 onglets à fusionner, par contre je veux que les quantités, chiffre d’affaire, marge… soit fusionner (additionné) entre les doublons.

Alors qu’elle est la meilleure méthode à votre avis ? des formules Excel imbriqué sur le quatrième onglet ? ou développer du code au sein du module visual basic d’Excel ? si une personne à une solution je suis preneur

Bonjour

Voici un exemple à adapter à ton cas.

Principe:
On parcourt les feuilles concernées et on ajoute une chaine contenant les données à une collection. Dans cette collection, on trouve donc les doublons éventuels
On se positionne sur la feuille de récap, et on itère sur chaque élément de la collection. On teste si la référence est déjà présente. Si oui, on ajoute des valeurs, sinon, on ajoute la donnée en bas du tableau.

Pour pouvoir itérer sur chaque feuille, il faut bien entendu que l'on puisse différencier les feuilles de données des autres. Dans mon exemple, les feuilles contenant les données sont nommée par Res_ suivi d'un numéro. Il suffit dès lors de tester si le nom de la feuille commence par Res_ et ton code fonctionnera indépendamment du nombre de feuilles de données.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Sub Recapitulatif()
    Dim Source As Worksheet
    Dim Recap As Worksheet
    Dim Donnees As New Collection
    Dim Cellule As Range
    Dim Donnee As String
    Dim Element As Variant
 
    ' Récupération des données des onglets
    ' On itère sur toutes les feuilles du classeur
    For Each Source In ThisWorkbook.Worksheets
    ' Si le nom commence par Res_, on ajoute les données à la collection    
    If Left(Source.Name, 4) = "Res_" Then
            For Each Cellule In Source.Range("a2:a" & Source.Range("a65536").End(xlUp).Row)
                ' Concaténation des données
                Donnee = Cellule & ";" & Cellule(1, 2) & ";" & Cellule(1, 3) & ";" & Cellule(1, 4)
                ' Ajout de l'élement dans la collection
                Donnees.Add Donnee
            Next Cellule
        End If
    Next Source
 
    ' Création de la liste dans l'onglet récapitulatif
    Set Recap = Worksheets("Récap")
    ' Vidange de la feuille de récap
    Recap.Range("a2:iv65536").ClearContents
    ' Itération sur les éléments de la collection
    For Each Element In Donnees
        ' Renvoie la cellule en A si élément présent, sinon NOTHING
        Set Cellule = CelluleRecap(Recap, Element)
        ' Si élément présent, on ajoute les valeurs aux valeurs présentes
        If Not Cellule Is Nothing Then
            Cellule(1, 2) = Cellule(1, 2) + Split(Element, ";")(1)
            Cellule(1, 3) = Cellule(1, 3) + Split(Element, ";")(2)
            Cellule(1, 4) = Cellule(1, 4) + Split(Element, ";")(3)
            Else
            ' Sinon, on ajoute une ligne avec les valeurs
            Set Cellule = Recap.Range("a65536").End(xlUp)(2)
            Cellule(1, 1) = Split(Element, ";")(0)
            Cellule(1, 2) = Split(Element, ";")(1)
            Cellule(1, 3) = Split(Element, ";")(2)
            Cellule(1, 4) = Split(Element, ";")(3)
        End If
    Next Element
 
End Sub
 
Function CelluleRecap(Feuille As Worksheet, ByVal Nom As String) As Range
    ' Si Nom est présent dans la colonne A de Feuille, renvoie la cellule en A
    ' Sinon, l'objet retourné est NOTHING
    Dim Cellule As Range
 
    For Each Cellule In Feuille.Range("a2:a" & Feuille.Range("a65536").End(xlUp).Row)
        If Split(Nom, ";")(0) = Cellule.Value Then
            Set CelluleRecap = Cellule
            Exit For
        End If
    Next Cellule
End Function

Je pense que tu peux adapter cela à ton cas.

Ok?

C'est tout à fait parfait ! Exactement ce qu'il me fallait merci beaucoup !!!!!