Microsoft 365 Créer plusieurs onglets

[themyse1]

Bonjour,

J'en appel a votre aide pour m'aider à solutionner mon problème de macro.
j'aimerais à partir de l'onglet données, créer 12 onglet ( 1 par mois) et récupérer sur chaque onglet les éléments du mois.
j'ai un bouton en "N" qui est censé le faire mais il ne me récupère que le mois de janvier et que les données de la première ligne.
Pouvez vous me dire comment je fais pour qu'il me récupère chaque lignes de chaque mois dans l'onglet correspondant.
j'espère avoir été clair.

Merci infiniment de l'aide que vous m'apporterez

 

[Lolote83]

Bonjour,
Avec cette petite macro
Attention, j'ai renommé ton onglet Données à la place de donées

Sub Création_Onglets()
    Application.ScreenUpdating = False
    xListeMois = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")

    For F = 0 To 11
        With Sheets("Données")
            xMois = xListeMois(F)
            .Range("$A$1:$M$820").AutoFilter Field:=1, Criteria1:=xMois
            .Range("A1:M820").Copy
        End With
       
        xNbrOng = ThisWorkbook.Sheets.Count
        Sheets.Add After:=Sheets(xNbrOng)
        ActiveSheet.Name = xMois
       
        With Sheets(xMois)
            .Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End With
    Next F
    With Sheets("Données")
        .Select
        .Range("$A$1:$M$820").AutoFilter Field:=1
    End With
    MsgBox "Traitement terminé", vbInformation, "Création onglets"
    Application.ScreenUpdating = True
    ActiveWindow.TabRatio = 0.744
End Sub

@+ Lolote83

 

[Cousinhub]

Bonjour,
Un essai avec ce code :

Sub Dispatch()
Dim Plg As Range, Cel As Range
Dim DerLig As Long
Dim Sh As Worksheet
Dim Le_Mois As Object
Dim It
Set Le_Mois = CreateObject("Scripting.Dictionary")
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
For Each Sh In Sheets
    If Sh.Name <> "Donées" Then Sh.Delete 'Oups, "Donées"....
Next Sh
With Sheets("Donées")
    DerLig = .Cells(Rows.Count, "A").End(xlUp).Row
    Set Plg = .Range("A1:M" & DerLig)
    .Range("Z1").Value = .Range("A1").Value
    For Each Cel In .Range("A2:A" & DerLig)
        Le_Mois(Cel.Value) = Cel.Value
    Next Cel
    For Each It In Le_Mois.Items
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = It
        .Range("Z2").Value = It
        Plg.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=.Range("Z1:Z2"), CopyToRange:=ActiveSheet.Range("A1"), Unique:=False
    Next It
    .Range("Z1:Z2").Clear
    .Select
End With
End Sub

Bonne journée

Edit, Oupss, pas vu Lolote (Meilleurs vœux)

 

[themyse1]

Bonjour,
Avec cette petite macro
Attention, j'ai renommé ton onglet Données à la place de donées

Sub Création_Onglets()
    Application.ScreenUpdating = False
    xListeMois = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")

    For F = 0 To 11
        With Sheets("Données")
            xMois = xListeMois(F)
            .Range("$A$1:$M$820").AutoFilter Field:=1, Criteria1:=xMois
            .Range("A1:M820").Copy
        End With
      
        xNbrOng = ThisWorkbook.Sheets.Count
        Sheets.Add After:=Sheets(xNbrOng)
        ActiveSheet.Name = xMois
      
        With Sheets(xMois)
            .Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End With
    Next F
    With Sheets("Données")
        .Select
        .Range("$A$1:$M$820").AutoFilter Field:=1
    End With
    MsgBox "Traitement terminé", vbInformation, "Création onglets"
    Application.ScreenUpdating = True
    ActiveWindow.TabRatio = 0.744
End Sub

@+ Lolote83

Tu es Formidable Merci Merci Merci

 

[themyse1]

Bonjour,
Un essai avec ce code :

Sub Dispatch()
Dim Plg As Range, Cel As Range
Dim DerLig As Long
Dim Sh As Worksheet
Dim Le_Mois As Object
Dim It
Set Le_Mois = CreateObject("Scripting.Dictionary")
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
For Each Sh In Sheets
    If Sh.Name <> "Donées" Then Sh.Delete 'Oups, "Donées"....
Next Sh
With Sheets("Donées")
    DerLig = .Cells(Rows.Count, "A").End(xlUp).Row
    Set Plg = .Range("A1:M" & DerLig)
    .Range("Z1").Value = .Range("A1").Value
    For Each Cel In .Range("A2:A" & DerLig)
        Le_Mois(Cel.Value) = Cel.Value
    Next Cel
    For Each It In Le_Mois.Items
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = It
        .Range("Z2").Value = It
        Plg.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=.Range("Z1:Z2"), CopyToRange:=ActiveSheet.Range("A1"), Unique:=False
    Next It
    .Range("Z1:Z2").Clear
    .Select
End With
End Sub

Bonne journée

Edit, Oupss, pas vu Lolote (Meilleurs vœux)

Merci de ton aide, c'est top

 

[themyse1]

Merci à tous les deux , je vais maintenant essayer de les comprendre, vous sauriez me dire quel était le problème avec la mienne? Meilleurs Vœux également.