IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

[Excel] Fusion de X onglets dans un seul onglet


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Inscrit en
    Septembre 2006
    Messages
    66
    Détails du profil
    Informations forums :
    Inscription : Septembre 2006
    Messages : 66
    Par défaut [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

  2. #2
    Rédacteur/Modérateur


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    Novembre 2003
    Messages
    19 125
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : Novembre 2003
    Messages : 19 125
    Billets dans le blog
    131
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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?
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes billets de blog sur DVP
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  3. #3
    Membre averti
    Inscrit en
    Septembre 2006
    Messages
    66
    Détails du profil
    Informations forums :
    Inscription : Septembre 2006
    Messages : 66
    Par défaut
    C'est tout à fait parfait ! Exactement ce qu'il me fallait merci beaucoup !!!!!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 3
    Dernier message: 18/07/2012, 23h44
  2. [XL-2003] copier les données d'un tableau d'un onglet dans un autre onglet suivant une condition
    Par chouki60 dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 28/02/2011, 07h48
  3. Fusion de deux pdf dans un seul fichier pdf
    Par PAULOM dans le forum ODS et reporting
    Réponses: 2
    Dernier message: 03/06/2010, 09h04
  4. [XL-2002] copier onglet dans un autre onglet
    Par patou41000 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 15/04/2009, 20h58
  5. création dynamique d'onglets dans d'autres onglets
    Par chourmo dans le forum Delphi
    Réponses: 4
    Dernier message: 18/07/2006, 12h12

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo