XL 2016 Création automatique d'onglet sur une base de travail

[p_michel]

Bonjour à tous,
Je suis à la recherche d'une formule ou plutôt d'une macro qui me permettrai de crée des onglets à partir d'un onglet ayant tous les éléments.
Je m'explique : j'ai un fichier source dans lequel des données sont rentrées et je souhaiterais tout en conservant l'onglet d'origine crée une macro qui me permettrai à chaque changement de nom ( en jaune ) la création d'un onglet qui non seulement reprendrai les données de l'onglet source mais en plus le nom ( en jaune dans mon fichier )
Je ne sais pas si je suis très clair mais je reste à votre disposition pour toute information complémentaire.
Je vous remercie par avance pour vos recherches.
Michel

 

[zebanx]

Bonjour,
Ci-joint un code VBA mais qui part uniquement de la première colonne.
Un spécialiste des scripting dictionnary nous trouvera peut-être l'utilisation de la cinquième colonne plutôt que la première et nous serons content tous les deux (!)

cdlt

 

[Robert]

Bonjour Michel, bonjour le Forum

pas le temps de commenter le code... Essaie comme ça :

Dim B As Worksheet
Dim O As Worksheet
Dim TV As Variant
Dim NL As Integer
Dim NC As Byte
Dim D As Object
Dim TMP As Variant
Dim I As Integer
Dim J As Byte
Dim K As Integer
Dim L As Integer
Dim TL() As Variant
Dim OD As Worksheet
Dim Da As Long

Set B = Worksheets("Bal Stat")
For Each O In Sheets
    Application.DisplayAlerts = False
    If Not O.Name = "Bal Stat" Then O.Delete
    Application.DisplayAlerts = True
Next O
TV = B.Range("A1").CurrentRegion
NL = UBound(TV, 1)
NC = UBound(TV, 2)
Set D = CreateObject("Scripting.Dictionary")
For I = 2 To NL
    D(TV(I, 5)) = ""
Next I
TMP = D.Keys
For L = 0 To UBound(TMP)
    K = 1
    For I = 1 To NL
        If TV(I, 5) = TMP(L) Then
            ReDim Preserve TL(1 To NC, 1 To K)
            For J = 1 To NC
                TL(J, K) = TV(I, J)
                If J = 16 Then Da = DateSerial(Year(TV(I, J)), Month(TV(I, J)), Day(TV(I, J))): TL(J, K) = Da
            Next J
            K = K + 1
        End If
    Next I
    If K > 1 Then
        Worksheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = TMP(L)
        Set OD = ActiveSheet
        B.Rows(1).Copy OD.Range("A1")
        OD.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1)
        OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
        OD.Columns(16).NumberFormat = "dd/mm/yy"
    End If
Next L
End Sub

Si tu as un soucis, je le commenterai...

 

[Jacky67]

je souhaiterais tout en conservant l'onglet d'origine crée une macro qui me permettrai à chaque changement de nom ( en jaune ) la création d'un onglet qui non seulement reprendrai les données de l'onglet source mais en plus le nom ( en jaune dans mon fichier )
Je ne sais pas si je suis très clair mais je reste à votre disposition pour toute information complémentaire.
Je vous remercie par avance pour vos recherches.
Michel

Bonjour,
Une proposition avec la méthode Filtre en PJ

 

[zebanx]

@Robert et jacky67
Merci pour ces codes.
Une précision svp : est-ce que l'on peut conserver les formules d'un tableau de base par une "déconsolidation" comme vous le proposez ou est-ce difficile, voire impossible svp ?

Vous remerciant pour cette précision. Bonne soirée.

 

[p_michel]

Merci à tous pour vos réponses.
N'étant au travail actuellement, je ne manquerais de vous faire à tous un retour dès demain matin.
Michel

 

[p_michel]

Bonjour à tous,
Un grand Merci pour votre aide. Le fichier de jacky67 est très utile et va me permettre de travailler plus vite.