Répartition de données dans plusieurs tableaux

Bonjour,

Je cherche sous la feuille "Articles par groupe" à distribuer mes données dans plusieurs listes ou tableaux indépendants.

Le critère principal est celui de la colonne D, l'idéal serait que je puisse avoir sur une liste tous les articles du groupe 05021540 suivi de la gamme ( si possible tous les 10 puis les 20 puis les 30...) avec ensuite le numéro d'article et enfin la désignation.

En gros quelque chose comme ceci:

05021540 10 260205001000 Pom.Boskoop I vrac

Et ainsi de suite pour tous les articles du même groupe, suivi directement ou de manière indépendante du groupe suivant.

Je cherche à automatiser ce procédé sans passer par les filtres afin de me faciliter la vie quand la base de données variera, ici selon les saisons fruits & légumes.

Je suis à vous pout toute question, j'espère être compréhensible

DrakeRamore

Bonjour Drake

Je t'envoie un fichier. La macro s'appelle eclater

Teste et dis-moi

Bon courage

A+

PS pour MFERRAND.... si tu vois mon tri à la fin de la macro eclater, tu vas être super content!!!

Bonsoir,

Une proposition à étudier.

La procédure crée un feuille par groupe...

J'ai supprimé les feuilles inutiles qui ralentissait la procédure (re calcul classeur ).

Cdlt.

Merci pour vos réponses!

Jean-Eric cela fonctionne parfaitement bien, même si l'idéal aurait été de rester sur une feuille c'est top! Merci!

Pour ce qui est de la solution à Patty la macro bug, j'ai des notions très sommaires de VBA et je n'identifie pas le problème...

Sub eclater()

Dim ws As Worksheet

Set ws = Worksheets("Feuil1")

j = 1

With Worksheets("Articles par groupe")

dlig = .Range("D" & Rows.Count).End(xlUp).Row

grp = .Range("D2").Value

ws.Cells(1, 1).Select

i = 2

suit:

While .Range("D" & i).Value = grp

ws.Range("A" & j).Value = grp

ws.Range("B" & j).Value = .Range("F" & i).Value

ws.Range("C" & j).Value = .Range("A" & i).Value

ws.Range("D" & j).Value = .Range("B" & i).Value

j = j + 1

i = i + 1

Wend

grp = .Range("D" & i).Value

If grp = "" Then GoTo tri

deb = i

GoTo suit

End With

tri:

Range("A1:E448").Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo, _

key2:=Range("B1"), order1:=xlAscending, Header:=xlNo

End Sub

Re

As-tu rajouté Feuil1 pour mettre les résultats ?

Chez moi cela marche

A+

Ah oui voilà en fait je n'étais pas sur la bonne feuille quelle nouille

Merci beaucoup, j'ai cherché à faire ça pendant 2 jours sans y arriver donc merci infiniment à vous de prendre le temps d'aider les novices!

Je ne suis pas encore au bout de mes peines avec ce fichier donc je reviendrez probablement vers vous, merci encore et bonne année!

Drake

Re,

On peut tout mettre sur une feuille.

La procédure crée un TCD avec un champ de page (Groupe). On affiche ensuite une page par groupe...

On peut garder le principe du TCD avec un champ de ligne supplémentaire correspondant au groupe.

A te relire.

Cdlt.

Bonsoir à tous

N'oublie pas de mettre le sujet en résolu

Bonne fin d'année

A+

Bonsoir à tous,

Pour le fun

Restitution en feuil1 préalablement créée

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, dico As Object
    a = Sheets("Articles par groupe").Range("a1").CurrentRegion.Value
    Set dico = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 4)) Then
            Set dico(a(i, 4)) = _
            CreateObject("System.Collections.SortedList")
        End If
        If Not dico(a(i, 4)).Contains(a(i, 6)) Then
            ReDim w(1 To 4, 1 To 1)
        Else
            w = dico(a(i, 4))(a(i, 6))
            ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
        End If
        w(1, UBound(w, 2)) = a(i, 4)
        w(2, UBound(w, 2)) = a(i, 6)
        w(3, UBound(w, 2)) = a(i, 1)
        w(4, UBound(w, 2)) = a(i, 2)
        dico(a(i, 4))(a(i, 6)) = w
    Next
    Application.ScreenUpdating = False
    With Sheets("feuil1")
        .UsedRange.Cells.Clear
        With .Range("a1")
            .Resize(, 4) = Array("Groupe", "gamme", "N° article", "Désignation")
            .Parent.Columns(3).NumberFormat = "@"
            n = 1
            For i = 0 To dico.Count - 1
                For j = 0 To dico.Items()(i).Count - 1
                    With .Offset(n).Resize(UBound(dico.Items()(i).GetByIndex(j), 2), _
                                           UBound(dico.Items()(i).GetByIndex(j), 1))
                        .Value = Application.Transpose(dico.Items()(i).GetByIndex(j))
                    End With
                    n = n + UBound(dico.Items()(i).GetByIndex(j), 2) + 1
                Next
            Next
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

Bonnes fêtes à tous

klin89