Reporter toutes les cellules d'une colonne en onglets

Le 21/09/2016 à 13:51

Bonjour à tous,

C'est mon premier message chez vous, je me lance donc dans le grand bain en espérant être le plus clair possible

J'ai un fichier excel contenant 4 colonnes (A: DATE, B:GROUPE, C:VILLE, D:LIEU) commencant à la deuxieme ligne (la premiere indique DATE / GROUPE / VILLE / LIEU).

Sur la colonne B il y a différentes occurrences, présentes soit une fois, soit plusieurs fois

J'ai créé un onglet pour chaque occurence différente de la colonne B.

J'aimerais arriver au résultat suivant :

Que l'ensemble des lignes faisant reference à la même occurrence (disons JOHN DOE) soit reporté automatiquement dans le bon onglet (qui porte aussi le nom JOHN DOE) et ce sans espaces entre les lignes.

Evidemment je pourrais le faire à la main mais si je demande votre aide ici c'est parce que j'ai un nombre incalculable de lignes à traiter...

Et aussi parce que je bloque totalement, j'ai l'impression qu'il n'y a pas d'equation pour ca et les Macro, je vous avoue que je suis totalement novice et ne connait pas du tout le langage...

Et surtout, est-ce possible ?

Merci par avance pour vos réponses !

Le 21/09/2016 à 15:37

Bonjour

Oui, c'est possible.

Un exemple sur ce fichier avec un code documenté d' Yvouille.

Cordialement

23dispatch-de-lignes-vers-feuilles.zip (17.30 Ko)
Le 21/09/2016 à 15:56

Bonjour Enaliem, Amadéus, bonjour le forum,

Dommage que tu n'aies pas daigné mettre un petit fichier exemple... Essaie le code ci-dessous. Il a l'avantage de créer automatiquement les onglet de chaque groupe (si ils n'ont pas été créés au préalable) :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (TeMPoraire)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec les données de la colonne 2 (=> Groupe) du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Worksheets(TMP(J)) 'définit l'onglet OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set OD = ActiveSheet 'définit l'onglet OD
        OD.Name = TMP(J) 'renomme l'onglet OD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    OD.Range("A1").Resize(1, 4) = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée (de l'onglet OD) la première ligne du tableau des valeurs TV
    K = 1 'initialsie la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
        If TV(I, 2) = TMP(J) Then 'condition : si la donnée ligne I colonne 2 de TV est égale a TMP(I) (le groupe)
            ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes (soit 4), K colonnes)
            For L = 1 To 4 'boucle 3 : sur les 4 colonnes du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la valeur de la colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si la variable K est supérieure à un (au moins une occurrence trouvée)
        OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée (de l'ongelt OD) le tableau TL transposé
        Erase TL 'efface le tableau TL
    End If 'fin de la condition
Next J 'prochain élément de la boucle 1
End Sub
Le 21/09/2016 à 16:18

Bonjour Amadeus et ThauThème,

Merci pour vos retours !!!

Je n'ai pas mis de document exemple parce que le fichier est censé être confidentiel...c'est un peu debile mais je n'en suis pas le propriétaire du coup pas trop de choix.

Merci en tout cas je regarde en ce moment !

ThauTheme, quand j'applique le code pas à pas, il me dit " Erreur d'execution "429" : Un composant ActiveX ne peut pas créer d'objet" au niveau de la ligne : Set D = CreateObject ("Scripting.Dictionary")

Je ne sais pas si cela change grand chose mais je suis sur Mac, Office 2015, ver. 15.25.

@Amadeus, je regarde merci !

Le 21/09/2016 à 16:30

Bonjour le fil, bonjour le forum,

Ah ! Chez moi ça marche mais je ne saurais te dire pourquoi ça plante avec ta version...

[Édition]

Le plan du doc confidentiel c'est du pipeau des Andes ! Rien ne t'empêche de créer un fichier avec des données bidons. La preuve :

20classeur1.xlsm (18.30 Ko)
Le 21/09/2016 à 19:22

Oui en effet, j'aurais pu tout simplement faire un fichier bidon, désolé ca ne m'est pas venu à l'esprit (la honte).

De mon côté ca bloque toujours sur le scripting.dictionary sur mon mac, j'ai cru comprendre qu'il y avait moyen de trouver un moyen de substitution à cette ligne sur mac, je vais me renseigner !

Merci beaucoup en tout cas, une fois reglé, ca devrait faire plus que me sauver !

Le 21/09/2016 à 19:50
ThauThème a écrit :

Le plan du doc confidentiel c'est du pipeau des Andes ! Rien ne t'empêche de créer un fichier avec des données bidons.

Bien d'accord avec toi

Pour le mac, il faut aller voir sur le site de J. Boisgontier qui dit:

"Sur MAC, Dictionary n'existe pas. Pour obtenir une liste sans doublons, utiliser Collection"

P.

Le 21/09/2016 à 23:17

Ah ah, non je vous assure c'est juste que je suis un peu con. Je me voyais à devoir changer toutes les valeurs des colonnes du fichier initial, alors qu'en créer un nouveau etait effectivment la solution la plus evidente...bref.

Bon désolé de vous emmerder, mais si l'un d'entre vous saurait comment contourner ce probleme de :

Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D

Ca me met :

Erreur d'exécution « 429 »:

Un composant ActiveX ne peut pas créer d'objet

Apparemment le scripting.dictionary n'est pas compatible avec les mac mais il y a cette solution : https://sysmod.wordpress.com/2011/11/02/dictionary-class-in-vba-instead-of-scripting-dictionary/

Mais je ne vois pas du tout comment importer dictionary.cls dans mon excel (Excel 2016 Mac) une fois le fichier telechargé, quand je vais dans le visual basic editor il n'y aucun endroit ou je vois la possibilité d'importer le fichier dans le projet.

J'ai essayé de copier/coller le code à l'interieur de dictionary.cls dans la fenetre de VBA mais le code apparait en partie en rouge et ca s'arrête la....(quand je vous dis que je suis une bille, je crois que le mot n'est pas assez fort).

Bref, si quelqu'un se sent l'âme charitable de m'expliquer comment regler ce probleme, sinon je vous remercie quand même pour votre aide c'est deja bien sympa !

++

Le 22/09/2016 à 09:11

Bonjour le fil, bonjour le forum,

la même solution, sans Dictionary, en utilisant une Collection pour éliminer les doublons :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As New Collection 'déclare la variable NC (Nouvelle Collection)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (TeMPoraire)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
    On Error Resume Next
    NC.Add TV(i, 2), TV(i, 2)
    On Error GoTo 0
Next I 'prochaine ligne de la boucle
For J = 1 To NC.Count 'boucle 1 : sur tous les éléments de la collection NC
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Worksheets(NC(J)) 'définit l'onglet OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set OD = ActiveSheet 'définit l'onglet OD
        OD.Name = NC(J) 'renomme l'onglet OD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    OD.Range("A1").Resize(1, 4) = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée (de l'onglet OD) la première ligne du tableau des valeurs TV
    K = 1 'initialsie la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
        If TV(I, 2) = NC(J) Then 'condition : si la donnée ligne I colonne 2 de TV est égale a NC(J) (le groupe)
            ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes (soit 4), K colonnes)
            For L = 1 To 4 'boucle 3 : sur les 4 colonnes du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la valeur de la colonne L de TV (=transposition)
                Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si la variable K est supérieure à un (au moins une occurrence trouvée)
    OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée (de l'ongelt OD) le tableau TL transposé
    Erase TL 'efface le tableau TL
    End If 'fin de la condition
Next J 'prochain élément de la boucle 1
End Sub

La méthode est assez similaire mais bien moins rapide quand il s'agit de traiter beaucoup de données (Jacques BOISGONTIER). J'espère qu'elle fonctionne sur Mac cette fois !...

Le 22/09/2016 à 10:57

ThauTheme, je ne sais que dire...MERCI ! MERCI ! MERCI !

T'es un boss !

Rechercher des sujets similaires à "reporter toutes colonne onglets"