Génération dynamique d'onglets en fonction d'un critère

Bonjour,

Après de nombreuses heures de recherche (merci a vous pour vos nombreuses lignes de codes !) je ne trouve pas la solution à mon soucis.

j'ai un extract sur le premier onglet.

A partir de cet extract, je souhaite copier des lignes sur les autres onglets en fonction du tag (colone A)

Le critère (le tag que je souhaite) sur trouve sur chaque onglet en A1 la copie de toute les lignes contenant lot1 doit se faire A partir de la cellule A3

Idem pour chaque lot.

L'idéal serait sur chaque onglet d'avoir un bouton, et qui copierais ou mettrais à jour les lignes.

Pourriez vous m'aidez sur ce sujet ?

si vous voyez une autre solutions je suis preneur.

l'idée est de faire un suivi dynamique des différents lots.

Il faut également que je puisse ajouter facilement des onglets suplémentaires, car le nombre de lot augmentera sans cesse.

je vous remercie par avance pour votre aide !

8test.xlsx (10.90 Ko)

Bonjour,

A tester :

Sub RépartirExtract()
    Dim lot$, dl%, fl%, i%, j%, ws As Worksheet
    With [ExTag]
        .Resize(, 12).Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 3), _
         order2:=xlAscending, Header:=xlNo
        dl = 1: i = 1
        Application.ScreenUpdating = False
        Do
            If .Cells(i + 1, 1) = .Cells(i, 1) Then
                i = i + 1
            Else
                fl = i: lot = .Cells(dl, 1)
                For j = 1 To Worksheets.Count
                    If Worksheets(j).Name = lot Then
                        Set ws = Worksheets(j)
                        Exit For
                    End If
                Next j
                If ws Is Nothing Then
                    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
                    ws.Name = lot
                    ws.Range("A1") = lot
                End If
                ws.Range("B1:L1").Value = .Offset(-1, 1).Resize(1, 11).Value
                ws.Range("B2:L" & fl - dl + 2).Value = .Cells(dl, 2).Resize(fl - dl + 1, 11).Value
                Set ws = Nothing
                i = i + 1: dl = i
            End If
        Loop While .Cells(dl, 1) <> ""
    End With
End Sub

Cordialement.

NB- plage ExTag nommée (voir Gestionnaire de noms)

19marmy-test.xlsm (24.52 Ko)

Ca m'as l'air génial ! je vais tester et réaliser quelques ajustement...mais ca me plait bien !

faut encore que je teste certains scénario mais le bouton rempli parfaitement son Rôle !

Rechercher des sujets similaires à "generation dynamique onglets fonction critere"