Création de ruptures par onglet selon condition

Bonjour,

Je souhaiterai créer une rupture d'onglet par manager selon l'exemple ci-joint. Est-ce possible?

Merci d'avance,

Cordialement,

Gwendoline

Bonsoir,

rupture d'onglet

quésaco??

Si vous fournissez le résultat à obtenir, la question sera beaucoup plus claire !

Bonjour Thev

Pour ma part j'ai compris qu'il voulait un onglet par manager qui reprenne les éléments du tableau

J'avais la même problématique mais un fichier par manager

Plutôt que d'adapter ce que j'ai, j'essaie de reconstruire quelque chose de plus structuré

Bonjour

est-ce que ceci ne suffit pas ?

... sinon

Option Explicit
Sub fragmenter()

Dim i%, cle As Variant
Dim sw As Worksheet
Dim dico As Object

    tri

    Set sw = ActiveSheet
    Set dico = CreateObject("Scripting.Dictionary")

    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1
    For i = 2 To [A1].End(xlDown).Row
        dico(Cells(i, 1).Value) = dico(Cells(i, 1).Value) + 1
    Next

    For Each cle In dico.Keys
        Debug.Print cle & " - " & dico(cle)

        ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:=cle
        ActiveSheet.ListObjects(1).Range.Select
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = cle
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$B$" & dico(cle) + 1), , xlYes).Name = cle
        ActiveSheet.ListObjects(1).TableStyle = "TableStyleMedium2"
        sw.Select

    Next
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1

End Sub

Bonjour,

Merci pour votre dernière réponse. C'est effectivement ce que je recherchais : fragmenter par manager.

Je n'ai pas Excel 2013 et ne peut donc réaliser la manipulation des segments.

Vous remerciant de vos réponses.

Crdt,

Bonjour,

Tardivement et pour le fun (connexion internet de m***e) .

Cdlt.

Sub Create_Worksheets()
Dim ws As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim tbl, k
Dim dict As Object
Dim i As Long

    Set lo = Range("T_Donn?es").ListObject
    tbl = lo.ListColumns(1).DataBodyRange
    Set dict = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(tbl)
        If tbl(i, 1) <> "" Then dict(tbl(i, 1)) = ""
    Next i

    With lo
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        With .Sort
            .SortFields.Add lo.ListColumns(1).DataBodyRange, xlSortOnValues, xlAscending
            .Apply
            .SortFields.Clear
        End With
    End With

    For Each k In dict.keys
        lo.Range.AutoFilter field:=1, Criteria1:=k
        lo.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        With ws
            .Name = k
            .Cells(1).PasteSpecial xlPasteValuesAndNumberFormats
            Set lo2 = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
            With lo2
                .Name = "T_" & Replace(k, " ", "_")
                .TableStyle = "TableStyleMedium2"
            End With
        End With
    Next k
    lo.Range.AutoFilter field:=1
End Sub

Bonjour,

Merci pour votre dernière réponse. C'est effectivement ce que je recherchais : fragmenter par manager.

Je n'ai pas Excel 2013 et ne peut donc réaliser la manipulation des segments.

Vous remerciant de vos réponses.

Crdt,

L'autre solution proposée est sans segment

Et tu peux même enlever le tri qui n'est pas nécessaire avant fragmentation.

Jean-Eric

j'ai remarqué dan excel remplaçait de lui-même l'espace par un blanc souligné dans les noms de tableaux.

Re,

@ Steelson,

Tu as entièrement raison !...

Une précaution inutile.

J'ai surtout voulu montrer la dénomination commençant par "T_" (ou tbl_)

Ceci pour différencier (éventuellement) les noms de plage et les tables (tableaux ou listes), etc...

Cdlt.

Je vais de mon côté m'inspirer de quelques lignes de ton code pour m’affûter sur les ListObjects

Bonjour,

Je reviens vers vous et vos connaissances en macro (je ne suis pas douée pour transposer les macros...)

J'ai une nouvelle liste et cette fois-ci, j'ai besoin d'avoir la liste du personnel par directeur(N-1) puis par N-2 s'il y en a un (j'ai mis l'exemple de ce que je souhaiterai dans le fichier à suivre la liste).

5classeur2.xlsx (21.88 Ko)

Pouvez-vous m'aider ?

Merci d'avance,

Crdt, Gwendoline

Voici

Option Explicit

Sub decomposer()
fragmenter 11, "_", 28
fragmenter 12, "__", 20
End Sub

Sub fragmenter(n As Integer, prefixe As String, couleur As Integer)
Dim i%, cle As Variant, sw As Worksheet, dico As Object, tbl As Variant

Set sw = ActiveSheet
Set dico = CreateObject("Scripting.Dictionary")

With ActiveSheet.ListObjects(1)

    If .ShowAutoFilter Then .AutoFilter.ShowAllData

    tbl = .ListColumns(n).DataBodyRange
    For i = 2 To UBound(tbl)
        dico(tbl(i, 1)) = dico(tbl(i, 1)) + 1
    Next

    For Each cle In dico.Keys
        If cle <> "" Then
            .Range.AutoFilter Field:=n, Criteria1:=cle
            .Range.Select
            Selection.Copy
            Sheets.Add After:=ActiveSheet
            With ActiveSheet
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .ListObjects.Add(xlSrcRange, Cells(1).CurrentRegion, , xlYes).Name = cle
                .ListObjects(1).TableStyle = "TableStyleMedium2"
                .Name = prefixe & cle
                .Tab.ColorIndex = couleur
            End With
            sw.Select
        End If
    Next

    .AutoFilter.ShowAllData

End With

Application.CutCopyMode = False

End Sub
9classeur2.xlsm (27.03 Ko)

Merci, parfait !

Bonne journée.

Gwendoline,

J'attends le nouveau challenge !

Michel

Rechercher des sujets similaires à "creation ruptures onglet condition"