Discussion :

[bibvba]

Bonjour,

Dans un tableau j'ai plusieurs cellules identiques dans la colonne A . Je souhaite trier ces trier ces cellules par onglets (en prenant leurs ligne entierement) pouvez-vous m'aider pour faire cette macro.

[fring]

Bonjour,

Un peu plus de détail serait le bien venu...

Je souhaite trier ces trier ces cellules par onglets (en prenant leurs ligne entierement)

C'est à dire ?
Les onglets sont créés à l'avance ?
Dans quel onglet faut copier quelle ligne ?

[bibvba]

Bonjour Fring,
Vous m'avez dépanné hiers avec se sujet:

"je cherche a créer autant d'onglet que de cellules différente dans une colonne, puis renommer ces onglets comme les celulles."

Je pensais pouvoir me débrouiller avec ca mais comme je suis débutant, je ne comprends pas la macro que vous m'avez envoyer.

Alors pour plus d'explications:
-Par rapport a hiers il faut, une foit les onglets créer et renommer, mettre toutes les cellules correspondante a l'intérieure.

exemple:
colonne A,
ligne 1= toto
ligne 2= tutu

faire un onglet qui s'appelle toto avec la ligne toto entière à l'interieur (soit la ligne 1)
puis faire un onglet qui s'appelle tutu avec la ligne tutu entière à l'interieur (soit la ligne2)

Attention, il peut y avoir dans la colonne A plusieur fois toto . dans ce cas il faut les mettre les un après les autre dans l'onglet toto.

Dites-moi si je ne suis pas clair!!!

[Qwazerty]

SAlut
Je pense que ca va le faire

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
Sub test()
Dim CelTest As Range
Dim SheetTest As Worksheet
 
    With Sheets("Feuil1")
        For Each CelTest In .Range(.Cells(Rows.Count, "A").End(xlUp), .Range("A2")) 'On remonte jusqu'a la 1er cellule de la colonne contenant les valeurs
            'On test voir si l'onglet correspondant a la valeur existe
            For Each SheetTest In Worksheets
                If SheetTest.Name = CelTest.Value Then
                    'L'onglet existe deja on envoie les donnée dedans
                    .Rows(CelTest.Row).Copy Sheets(CelTest.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    'On passe directement a la ligne suivante
                    GoTo Suite
                End If
            Next
            'Si on arrive ici c'est qu'on a pas trouvé d'onglet portant le nom de la cellule en cours
            'On cré donc cet onglet
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = CelTest.Value
            'Et on y met les données
            .Rows(CelTest.Row).Copy Sheets(CelTest.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Suite:
        Next
    End With
End Sub

J'ai fait le joint avec ton precedent mail
A++
Qwaz

[fring]

Bonsoir tlm,

oui bibvba c'est plus clair mais attention, la macro que je t'ai envoyée sur ton sujet précédent ne conviendra pas, je n'ai pas tenu compte des éventuels doublons, c'est à dire que si tu as 3x toto, il va te créer 3 feuilles toto, je ne l'avais pas compris comme ça.

Donc oublie ce que je t'ai envoyé et utilises la macro que te propose Qwazerty déjà adaptée dans ce sens

@+

[bibvba]

bonjour et merci d'avoir répondu,

ca fonctionne jusqu'a la la ligne

"Sheets(Sheets.Count).Name = CelTest.Value"

après ca bloc

[fring]

J'ai testé le code de Qwartz et à mon avis ça bug parce que tu as une cellule vide dans ta colonne A ?

Si c'est ça, ajoute les lignes suivantes :

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
Sub test()
Dim CelTest As Range
Dim SheetTest As Worksheet
 
    With Sheets("Feuil1")
        For Each CelTest In .Range(.Cells(Rows.Count, "A").End(xlUp), .Range("A2")) 'On remonte jusqu'a la 1er cellule de la colonne contenant les valeurs
        If CelTest.Value <> "" Then 'si la cellule n'est pas vide on continue la procédure
            'On test voir si l'onglet correspondant a la valeur existe
            For Each SheetTest In Worksheets
                If SheetTest.Name = CelTest.Value Then
                    'L'onglet existe deja on envoie les donnée dedans
                    .Rows(CelTest.Row).Copy Sheets(CelTest.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    'On passe directement a la ligne suivante
                    GoTo Suite
                End If
            Next
            'Si on arrive ici c'est qu'on a pas trouvé d'onglet portant le nom de la cellule en cours
            'On cré donc cet onglet
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = CelTest.Value
            'Et on y met les données
            .Rows(CelTest.Row).Copy Sheets(CelTest.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Suite:
        End If
        Next
    End With
End Sub

[bibvba]

Merci, mais Désolé ca bloc toujours au même endroit

[fring]

Alors je vois pas comme ça sans avoir le fichier sous les yeux

Tu ne peux pas mettre une copie en pièce jointe ?

[bibvba]

ok ci-joint la piece jointe

[fring]

Désolé mais le code de Qwartz fonctionne nickel chez moi, aucun bug

[Qwazerty]

Re
Chez moi aussi ça marche au poile avec ton fichier.
Tu as fais du pas a pas pour voir les différentes valeurs ?
A++
Qwaz

[bibvba]

exact, je ne sais pas ce que j'ai fait.

Merci pour avoir résolu ma macro.