Regrouper plusieurs données de différentes Feuilles en 1

Le 28/07/2017 à 09:51

Bonjour à tous,

Voici mon problème.

J'ai un tableau qui reprend les listes des participants a une activité annuelle.

J'aimerais pouvoir faire un récapitulatif de tous les participants depuis le début et les éditions a venir.

En colonne A de chaque année il y a les nom et prénom et en colonne B les pelotons.

Ce que je souhaite c'est juste regrouper toutes les colonnes A et sans doublons de manière automatique (Sans bouton )

je me doute qu'il faut une macro, mais je bug....

Merci de vos réponses

24participation-test.xlsx (21.88 Ko)
Le 28/07/2017 à 10:07

Bonjour Damsa bonjour le forum,

Automatique (sans bouton) ?!... Tu vois ça comment ?

  • Tu lances la macro manuellement ?
  • Le code s'effectue chaque fois que tu rajoute un nom dans un onglet ?
  • Par une opération du saint esprit ?...
Le 28/07/2017 à 10:13

Bonjour,

Il n'y a pas moyen que ça se fasse des que l'on ouvre le fichier?

Je ne sais pas, c'est une question...

Si pas et qu'il faut mettre un bouton... Pas de soucis... je ferais avec .... LOL

Le 28/07/2017 à 10:20

Re,

Si, si. Ça peut se faire à l'ouverture du fichier. Mais pourquoi ne pas le demander d'entrée ?!... Je vais regarder ça...

Le 28/07/2017 à 11:09

Re,

Code a placer dans le composant ThisWorkbook :

Private Sub Workbook_Open() 'a l'ouverture du classeur
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)

Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet
        Case "Participations" 'cas "Participations"
            O.Range("A1").CurrentRegion.Clear 'efface toutes les cellules
        Case Else 'tous les autres cas
            If O.Range("A1").Value = "" Then 'condition : si A1 est vide
                GoTo suite 'va à l'étiquette "suite"
            Else 'sinon
                TV = O.Range("A1").CurrentRegion 'definit le tableau des valeurs TV
                For I = 2 To UBound(TV, 1) 'boucles eur toutes les ligne I du tableau des valeurs TV (en partant de la seconde)
                    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
                Next I 'prochaine ligne de la boucle
            End If 'fin de la condition
    End Select 'fin de l'action en fonction du nom de l'onglet
suite: 'étiquette
Next O 'prochain onglet de la boucle
With Sheets("Participations") 'prend en compte l'onglet "Participations"
    .Activate 'acticve l'onglet
    .Range("A1").Value = "Nom & Prénom" 'écrit "Nom & Prénom" en A1
    'renvoie en A2 redimensionnée, transposée, la liste des éléments du dictionnaire D sans doublon
    .Range("A2").Resize(D.Count, 1) = Application.Transpose(D.keys)
End With 'fin de la prise en compte de l'onglet "Participations"
End Sub
Le 28/07/2017 à 11:49

Nickel.

Merci Beaucoup.

Est ce normal qu'il y ai un une ligne sans rien entre une partie des nom?

Merci encore

33participation-test.xlsm (38.66 Ko)
Le 28/07/2017 à 12:08

Re,

C'est pas vraiment anormal puisque ton fichier comportes des caractères fantômes (des espaces ou autres que l'on ne voit pas mais qui considèrent la cellule comme non vide. Il te faudrait nettoyer tout ça...

Le code modifié qui semble ne plus poser ce problème :

Private Sub Workbook_Open() 'a l'ouverture du classeur
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)

Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Sheets 'boucle sur tous les onglets O du classeur
   Select Case O.Name 'agit en fonction du nom de l'onglet
       Case "Participations" 'cas "Participations"
           O.Range("A1").Cells.Clear 'efface toutes les cellules
       Case Else 'tous les autres cas
           If O.Range("A1").Value = "" Then 'condition : si A1 est vide
               GoTo suite 'va à l'étiquette "suite"
           Else 'sinon
               TV = O.Range("A1").CurrentRegion 'definit le tableau des valeurs TV
               For I = 2 To UBound(TV, 1) 'boucles eur toutes les ligne I du tableau des valeurs TV (en partant de la seconde)
                   If TV(I, 1) <> "" Then D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
               Next I 'prochaine ligne de la boucle
           End If 'fin de la condition
   End Select 'fin de l'action en fonction du nom de l'onglet
suite: 'étiquette
Next O 'prochain onglet de la boucle
With Sheets("Participations") 'prend en compte l'onglet "Participations"
   .Activate 'acticve l'onglet
   .Range("A1").Value = "Nom & Prénom" 'écrit "Nom & Prénom" en A1
   'renvoie en A2 redimensionnée, transposée, la liste des éléments du dictionnaire D sans doublon
   .Range("A2").Resize(D.Count, 1) = Application.Transpose(D.keys)
End With 'fin de la prise en compte de l'onglet "Participations"
End Sub
Le 28/07/2017 à 13:33

Merci,

Ça a fonctionné, et en faisant la mise en page, l'espace est revenu, pourtant j'ai nettoyé pour les caractères fantômes, mais bon, c'est pas trop grave.

Encore Merci

Rechercher des sujets similaires à "regrouper donnees differentes feuilles"