Création plusiseurs onglets avec report de données

Sincèrement vous m'avez perdu ...

Bonsoir

Oui, moi aussi je suis perdu :

voilà, mais je ne comprends pas trop le but ni l'objectif.

Bonne soirée.

Cordia5

@Cordia, dans ta dernière version, quand on enlève le filtre l'affichage ne reprend pas toute la base.

In fine je préfère la solution plus simple d'avoir juste le segment sans macro que tu as proposée.

@Storm, désolé de t'avoir perdu ... tu as 3 versions que je reproduit.

Tu joues avec les 3 et tu fixes ton choix sur l'une d'elles.

@Cordia (et seulement lui sinon Storm28 tu vas encore être plus perdu)

Juste pour le fun ... pour afficher les choix dans le nom de l'onglet (le but étant de "leurrer" un changement d'onglet - cela fait parfois plaisir aux chefs), j'ai ajouté un décompte

=sous.total(2, une_colonne_quelconque)

Avec une macro événementielle

Private Sub Worksheet_Calculate()
ActiveSheet.Name = choix
End Sub

et une fonction macro

Function choix() As String
Dim drapeau As Boolean
drapeau = True
choix = ""
With ActiveWorkbook.SlicerCaches("Segment_Article")
    For i = 1 To .SlicerItems.Count
        If .SlicerItems(i).Selected Then
            choix = choix & .SlicerItems(i).Name & " | "
        Else
            drapeau = False
        End If
    Next i
End With
choix = IIf(drapeau, "data", Mid(choix, 1, Len(choix) - 3))
End Function

Bonjour

Merci Steelson, et le forum

je jetterai un oeil dessus.

Bonne semaine.

Cordia5

Steelson,

La 3ième proposition me semble intéressante.

Merci à toi,

Storm28

Bonsoir,

Je n'arrive pas à réaliser la même chose que le fichier Storm28.v1 car, j'ai un code en jaune lorsque je change les données du code et que j'insert de nouvelles données dans data

@Steelson, pourrais-tu m'aider, merci ?

Storm28

Bonjour,

pas de soucis, peux-tu m'en dire davantage en ce qui concerne le code en erreur ?

si besoin, envoie ton fichier en mp si sensible

Je viens de t'envoyer un mail avec le fichier Excel

Storm28 a écrit :

Je n'arrive pas à réaliser la même chose que le fichier Storm28.v1

Voici une variant de la solution v1 pour intégrer cela dans une solution déjà fort complexe en terme de macros, de userform et d'onglets multiples !!

Ici le but est de distinguer les onglets concernés par une codification particulière : le nom d'onglet commence et se termine par _

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Left(Sh.Name, 1) = "_" And Right(Sh.Name, 1) = "_" Then
        Sheets("data").Cells(Rows.Count, 1).End(xlUp).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh.Range("A1").CurrentRegion, CopyToRange:=Sh.Range("A6").CurrentRegion.Resize(1), Unique:=False
    End If
End Sub

Par contre, si je rajouter des lignes, cela ne prends pas en compte.

Comment je peux faire cela ?

Merci de ton retour,

Storm28

Toutes les lignes, dès lors qu'elles sont contiguës sont prises en compte par l'instruction CurrentRegion

Cells(Rows.Count, 1).End(xlUp).CurrentRegion

ok d'accord mais je dois écrire le nom des onglets à l'avance pour que cela fonctionne

non ?

Mais peut-on le faire en automatique ?

Si c'est juste pour imprimer article par article sur une page, il y a d'autres solutions comme faire une macro qui va filtrer chaque article puis éditer

Maintenant OUI je peux créer les onglets en automatique mais je trouve qu'il y a des articles au nom baroque (comme "NE PAS EFFACER - non sur plat") !

En automatique

Sub creerfeuilles()
Dim data() As Variant
Dim dico As Object
Dim nouveau As Worksheet

    With Sheets("data")
        ReDim choix(1 To 1)
        data = .Range("F4:F" & .Range("F" & Rows.Count).End(xlUp).Row).Value
        Set dico = CreateObject("Scripting.Dictionary")
        For iData = 1 To UBound(data)
            dico(CStr(data(iData, 1))) = ""
        Next iData
    End With
    For Each cle In dico
        Sheets("model").Cells.Copy
        Set nouveau = ThisWorkbook.Sheets.Add
        With nouveau
            .Paste
            .Name = "_" & cle & "_"
            Sheets("data").Cells(Rows.Count, 1).End(xlUp).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.Range("A1").CurrentRegion, CopyToRange:=.Range("A6").CurrentRegion.Resize(1), Unique:=False
        End With
    Next

End Sub

Super !

Merci Steelson !

Dernière chose (désolé ...)

Actuellement, je peux créé les onglets avec le fichier mais, je ne peux pas actualiser les données.

Peut-on mettre dans le code une "sorte" de loop pour rafraichir les données à chaque fois ?

Merci par avance,

Storm28

Les données des onglets déjà créés sont rafraîchis.

En effet, pour les nouveaux ce n'est pas le cas ...

Le module 6 modifié :

Sub creerfeuilles()
Dim data() As Variant
Dim dico As Object
Dim nouveau As Worksheet

    With Sheets("data")
        ReDim choix(1 To 1)
        data = .Range("F4:F" & .Range("F" & Rows.Count).End(xlUp).Row).Value
        Set dico = CreateObject("Scripting.Dictionary")
        For iData = 1 To UBound(data)
            dico(CStr(data(iData, 1))) = ""
        Next iData
    End With
    For Each cle In dico
        Sheets("model").Cells.Copy
        If Not FeuilleExiste("_" & cle & "_") Then
            Set nouveau = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            With nouveau
                .Paste
                .Name = "_" & cle & "_"
                Sheets("data").Cells(Rows.Count, 1).End(xlUp).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("A1").CurrentRegion, CopyToRange:=.Range("A6").CurrentRegion.Resize(1), Unique:=False
            End With
        End If
    Next

End Sub

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function