Tri en masse Excel 2007

Bonjour,
Combien as tu de familles? Sous familles?
Tu fais une extraction régulièrement ou c'est juste pour une fois?

Merci de ta réponse

J'ai environ 40 familles et 100 sous familles au total.

C'est une extraction que je fais régulièrement pour différent traitement donc c'est pour cela que je voudrai automatiser au mieux la chose pour gagner du temps

Merci encore

En faite je veux une feuille par famille sous famille

Ex Famille 1 Sous Famille 1
Ex Famille 1 Sous Famille 2
Ex Famille 1 Sous Famille 3
Ex Famille 2 Sous Famille 1
Ex Famille 2 Sous Famille 2
Ex Famille 2 Sous Famille 1
Ex Famille 2 Sous Famille 3

Donc la feuille 1 c'est Famille 1 Sous Famille 1
la feuille 2 c'est Famille 1 Sous Famille 2
la feuille 3 c'est Famille 1 Sous Famille 3
etc...

Et en gardant les entete de colonnes comme tu as dis

Sincerement un grand merci de ton aide

Effectivement cela fais beaucoup de feuilles excel mais toutes les formes de famille/ ss famille ne sont pas utilisé. En gros il faut compter max 200 feuilles excel.

Oui une sécurité c'est mieux

Merci

ok

Oui il n'y a aucune cellule vide dans chaque colonne

Bon 16:56, ma solution.
Testée sur 35 000 lignes et l'ajout de 100 feuilles, durée 12,54 secondes...
Pour plus de lignes et plus de feuilles, prévoir plus de temps!
J'ai enlevé l'option de vérification de l'existence des feuilles. Si tu ne le fais qu'une fois par fichier, elle est inutile.

Précaution d'usage :
Travailler sur une copie de votre fichier..... Ne venez pas pleurer si vos données sont irrémédiablement perdues...

Voici le code de la macro à insérer dans un module standard :

Option Explicit 
Option Base 1 

Sub Repartition() 
Dim DicoConcat As Object 
Dim concat(), Colonns(), TablDico() 
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long 

Application.ScreenUpdating = False 
With Sheets("Feuil1") 
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row 
    ReDim concat(DrLig) 
    ReDim Colonns(1 To DrLig, 1 To 6) 
    For i = 2 To DrLig 
        For j = 1 To 6 
            Colonns(i - 1, j) = .Cells(i, j) 
        Next j 
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6) 
    Next i 
End With 
Set DicoConcat = CreateObject("Scripting.Dictionary") 
For i = LBound(concat) To UBound(concat) 
    DicoConcat(concat(i)) = "" 
Next i 
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then 
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable." 
    Exit Sub 
End If 
TablDico = DicoConcat.keys 
'Si vous souhaitez tester si la feuille a déjà été créée 
'enlevez les apostrophes en début des lignes suivantes 
For i = 1 To UBound(TablDico) - 1 
'    If FeuilleExiste(TablDico(i)) = False Then 
        ThisWorkbook.Worksheets.Add 
        With ActiveSheet 
            .Name = TablDico(i) 
            .Range("A1") = "Fournisseur" 
            .Range("B1") = "Ref" 
            .Range("C1") = "Description" 
            .Range("D1") = "Prix" 
            .Range("E1") = "Famille" 
            .Range("F1") = "Sous famille" 
            For j = 1 To UBound(concat) 
                If concat(j) = TablDico(i) Then 
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row 
                    For Col = 1 To 6 
                        .Cells(Lig, Col) = Colonns(j, Col) 
                    Next 
                End If 
            Next j 
        End With 
'    Else 
'        With Sheets(concat) 
'            .Cells.Clear 
'        End With 
'    End If 
Next i 
Sheets("Feuil1").Select 

End Sub 

Function FeuilleExiste(NomFeuille) As Boolean 
    Dim f As Object 
    On Error Resume Next 
    Set f = Sheets(NomFeuille) 
    If Err = 0 Then FeuilleExiste = True 
    Set f = Nothing 
End Function

J'oubliais... Vérifiez bien que toutes vos donénes sont encore présentes après traitement...
Possibilité également d'effacement de la feuille Feuil1, mais vérifiez vos données au préalable...
Cordialement,
Franck P

Je test cela rapidement et je te dis. Un grand merci de ta réponse et ton efficacité. Bon weekend à toi

Bon ceci semble mieux fonctionner.....
Il faut remplacer la ligne :

For i = 1 To UBound(TablDico) - 1

par :

For i = 0 To UBound(TablDico) - 1

soit :

Option Explicit
Option Base 1

Sub Repartition()
Dim DicoConcat As Object
Dim concat(), Colonns(), TablDico()
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long

Application.ScreenUpdating = False
With Sheets("Feuil1")
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim concat(DrLig)
    ReDim Colonns(1 To DrLig, 1 To 6)
    For i = 2 To DrLig
        For j = 1 To 6
            Colonns(i - 1, j) = .Cells(i, j)
        Next j
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6)
    Next i
End With
Set DicoConcat = CreateObject("Scripting.Dictionary")
For i = LBound(concat) To UBound(concat)
    DicoConcat(concat(i)) = ""
Next i
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable."
    Exit Sub
End If
TablDico = DicoConcat.keys
'Si vous souhaitez tester si la feuille a déjà été créée
'enlevez les apostrophes en début des lignes suivantes
For i = 0 To UBound(TablDico) - 1
'    If FeuilleExiste(TablDico(i)) = False Then
        ThisWorkbook.Worksheets.Add
        With ActiveSheet
            .Name = TablDico(i)
            .Range("A1") = "Fournisseur"
            .Range("B1") = "Ref"
            .Range("C1") = "Description"
            .Range("D1") = "Prix"
            .Range("E1") = "Famille"
            .Range("F1") = "Sous famille"
            For j = 1 To UBound(concat)
                If concat(j) = TablDico(i) Then
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                    For Col = 1 To 6
                        .Cells(Lig, Col) = Colonns(j, Col)
                    Next
                End If
            Next j
        End With
'    Else
'        With Sheets(concat)
'            .Cells.Clear
'        End With
'    End If
Next i
Sheets("Feuil1").Select

End Sub

Function FeuilleExiste(NomFeuille) As Boolean
    Dim f As Object
    On Error Resume Next
    Set f = Sheets(NomFeuille)
    If Err = 0 Then FeuilleExiste = True
    Set f = Nothing
End Function

Merci, mais de mon coté cela ne fonctionne pas, il me crée quelques feuilles et c'est tout mais tu as fais un très bon boulot quand meme

Je viens de viens de faire un test. Quand je supprime les informations dans la colonne C "Description" cela fonctionne très bien. Je ne comprends pas pourquoi ca ne passe pas avec la description.
De plus je vais surement être trop gourmand, mais est il possible que le nom des feuilles soit un nom donné. Par ex la famille 1 sous famille 1 Banane, la famille 1 sous famille 2 Pomme ?

je viens de comprendre, dans la colonne C il y a des symboles = / + .... si je les enlève et laisse le texte tout se passe bien. Maintenant ou modifier dans le code pour que les symboles ne m'embêtent plus ?

Bonjour,

Oui un petit weekend travail et toi ?

Je pensais pour le changement de nom créer une feuille avec :
2_1 = Pomme
2_2 = Banane....

De là lancer une macro qui va lire et remplacer.

Pour les symboles ce sont : ><-+=

Encore merci de ton aide

Non aucune formule, les symboles ont été mit dans la description simplement pour la compréhension ex :
CUVE >12345678
BILLE $
FIL HUILE >a5879/2 >

Les familles et sous familles ne changerons jamais, au pire ce qu'il peut arriver c'est qu'il faille en rajouter

ex : 01_07 : Famille : Moteur Ss famille : Volant moteur et j'aimerai afficher a la place de 01_07 : Volant moteur

Ok pour ton code famille sous famille donc si je comprends bien en feuille deux je mets la désignation en face mais cela va t il modifier le nom de la feuille ou pas ?

Pour les symboles le mieux c'est qu'ils restent en place, mais si pour se faciliter la tache on les enleves ce n'est pas grave

Ok mais est il possible de mettre cela en dur une liste ? Car en faite ces macro seront utilisé par plusieurs personnes et je les voient pas rentrer a chaque fois les nom des familles sous famille

Pour moi quand je lance la macro elle se lance mais au bout de quelques secondes cela plante, si j'enleve tous les symboles cela fonctionne

Ok pour les symboles.

Si tu peux tout jumelé ensemble pourquoi pas, si cela est possible

sincerement ce n'est pas grave si je perds 2mn car actuellement on fait cela a la mains j'en ai pour 1 bonnes journée, merci