Fonction simple de recopie (mais pas pour une néophyte!)

Bonjour à tous les membres de la communauté!

Ce que je vais vous demander est assez simple (mis à part pour moi, en tant que pure néophyte!):

J'aimerai créer des onglets pour chaque titre (A, B, C, D). Ces onglets se compléteraient automatiquement au fur et à mesure que je renseignerai des informations à propos de chaque titre dans la "Feuil1"

Je pensais à la fonction INDEX+EQUIV mais je n'arrive pas à la mettre en place !

à tous ceux qui m'apporteront des éléments de réponse !

Bonjour,

Une proposition VBA à étudier.

A te relire.

Cdlt.

Option Explicit

Private Sub cmdCreateWorksheets_Click()
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim FieldNum As Long, lRow As Long

    With Application
        .DisplayAlerts = False
        '.EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then ws.Delete
    Next ws

    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)
    FieldNum = 1

    If lo.ShowAutoFilter Then
        If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
    Else
        lo.ShowAutoFilter = True
    End If

    Set ws2 = ActiveWorkbook.Worksheets.Add
    With ws2
        lo.ListColumns(FieldNum).Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=.Cells(1), _
                Unique:=True
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For Each Cell In .Range("A2:A" & lRow)
            lo.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & Cell.Value
            Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            WSnew.Name = Cell.Value
            lo.Range.SpecialCells(xlCellTypeVisible).Copy
            With WSnew
                With .Range("A1")
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial xlPasteValuesAndNumberFormats
                End With
                Application.CutCopyMode = False
                Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(1).CurrentRegion, , xlYes)
                With lo2
                    .TableStyle = "TableStyleLight1"
                End With
                .Activate
                .Cells(1).Select
                ActiveWindow.DisplayGridlines = False
            End With
            lo.Range.AutoFilter Field:=FieldNum
        Next Cell
    End With

    ws2.Delete
    ws.Activate

    MsgBox "Terminé"

    With Application
        .DisplayAlerts = True
        '.EnableEvents = True
    End With

    Set lo = Nothing
    Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing

End Sub

Je te suis d'une extrême reconnaissance, grâce à toi je vais pouvoir avancer convenablement à présent

Je vais devoir adapter ton code à mon classeur, je reviendrai te voir en MP en cas de gros blocage !

Bonjour Jean-Eric,

J'aurai une énième information à te demander. J'ai changé le code VBA en fonction de mon propre tableau (les "Titres" devant se retrouver dans différentes feuilles ne se situent plus dans la colonne A mais dans la colonne H) mais, cela ne marche pas, sans que je comprenne le soucis.

P.S: si possible, pourrai-tu inscrire quelques commentaires au niveau du code afin que je puise davantage comprendre ? (je débute mon apprentissage du VBA)

Option Explicit

Private Sub cmdCreateWorksheets_Click()
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim FieldNum As Long, lRow As Long

    With Application
        .DisplayAlerts = False
        '.EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then ws.Delete
    Next ws

    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)
    FieldNum = 1

    If lo.ShowAutoFilter Then
        If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
    Else
        lo.ShowAutoFilter = True
    End If

    Set ws2 = ActiveWorkbook.Worksheets.Add
    With ws2
        lo.ListColumns(FieldNum).Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=.Cells(1), _
                Unique:=True
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For Each Cell In .Range("H2:H" & lRow)
            lo.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & Cell.Value
            Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            WSnew.Name = Cell.Value
            lo.Range.SpecialCells(xlCellTypeVisible).Copy
            With WSnew
                With .Range("H1")
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial xlPasteValuesAndNumberFormats
                End With
                Application.CutCopyMode = False
                Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(1).CurrentRegion, , xlYes)
                With lo2
                    .TableStyle = "TableStyleLight1"
                End With
                .Activate
                .Cells(1).Select
                ActiveWindow.DisplayGridlines = False
            End With
            lo.Range.AutoFilter Field:=FieldNum
        Next Cell
    End With

    ws2.Delete
    ws.Activate

    MsgBox "Terminé"

    With Application
        .DisplayAlerts = True
        '.EnableEvents = True
    End With

    Set lo = Nothing
    Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing

End Sub

Bonjour,

Je te renvoie le fichier avec le code commenté.

Mais j'ai de nouveau modifié tes données en les mettant sous forme de tableau (Excel 2007+).

Pour comprendre la procédure, tu dois connaître l'utilisation du filtre avancé sous Excel.

A te relire, si mes commentaires sont insuffisants.

Cdlt.

Tes commentaires m'ont bien aidés et je me suis renseignée sur les filtres avancés d'Excel.

J'ai même réussi à améliorer le code !

Cependant, je rencontre toujours des soucis lors de la création d'une bouton contrôle de formulaire. Aucune macro ne semble exister lorsque je souhaite en affecter une.

Comment procèdes-tu lors de la création du tien ?

Re,

Moi j'ai opté pour un contrôle ActiveX (CommandButton), qui offre des options qu'un contrôle de formulaire (Bouton) n'a pas.

Maintenant, si tu veux absolument avoir un bouton, tu dois renommer le nom de la procédure et remplacer 'Private' par 'Public'.

Tu affectes ensuite cette nouvelle procédure à ton bouton.

Cdlt.

Bonjour (à nouveau),

J'aimerai modifier à nouveau mon code (je l'ai mis en "Public") en y rajoutant deux nouvelles conditions:

Dans les feuilles, se renseigneraient automatiquement les éditions pour lesquelles il y a une absence de commission (ainsi que le N° de facture, la date de parution-voir colonnes en jaune; les autres n'étant pas nécessaires).

Aussi j'aimerai ajouter une fonction "TOTAL" au bas de la colonne "Commission" (malgré le fait qu'elle soit vide, vu que l'on veut les éditions pour lesquelles il n'y a pas de commission)

Serait-ce possible ?

Bonjour,

Tu aurais dû ouvrir un nouveau sujet car il est différent.

Cependant, j'ai modifié la procédure existante pour répondre à tes attentes. Le code n'est plus optimisé.

A tester et me redire.

Cdlt.

Je n'y avais pas songé...

Une erreur 404 apparaît lorsque j’exécute ma macro.

En outre, ne pourrait-on pas laisser la feuille "Données" intacte lors de l’exécution ?

Re,

Ou se situe l'erreur ? Tu as un message d'alerte.

Et la feuille Données est intacte dans le fochier fourni.

Cdlt.