Ventillation de Données

Bonjour Le Forum

Je vous joins mon classeur, pour pouvoir m'aider à mettre au point le programme ou fonction qui me permet de ventiler les données contenues dans la Feuille Source sur les autres feuille par mois de janvier à Décembre, ce ci en cliquant sur la case

Ventilation de données en E1

Bonjour!

Merci d'avance à tous

Hosni

Bonjour!

Pardon, Grand MERCI à Tous d'avance

Hosni

Bonjour Hosni,

Une proposition à coller dans le code de la feuille source :

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim w(0 To 12) As Worksheet, i&, n&(0 To 12), m%
    If Target.Row = 1 And Target.Column = 5 Then
        For i = 0 To 12
            Set w(i) = Worksheets(i + 1)
            n(i) = WorksheetFunction.Max(4, w(i).Cells(Rows.Count, 1).End(xlUp).Row + 1)
        Next i
        For i = 4 To n(0)
            m = Month(w(0).Cells(i, 3))
            w(0).Rows(i).Copy Destination:=w(m).Cells(n(m), 1)
            n(m) = n(m) + 1
        Next i
    End If
End Sub

Et double-Cliquer sur la cellule rouge de la feuille source. cordialement

Jules

Bonjour à Tous

Salut à toi Jules237, merci pour ta réponse rapide et efficace, c'est ce que je voulais à un petit détail prêt, comment faire pour copier aussi l'en tête du tableau, désolé d'abuser de ton indulgence et merci encore.

A plus

Hosni

Bonjour à Tous et toi Jules237

Comme déjà vu, la ventilation se passe bien mais, la procédure a tendance à rajouter à chaque ventilation, si possible de faire un RAZ des feuilles de de Janv à Déc avant chaque Ventilation.

Quelqu'un pourrait me donner l'astuce fonction VBA ou Excel.

Merci à tous

Hosni

Bonjour Hosni,

Le code incluant la RAZ

 Option Explicit

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim w(0 To 12) As Worksheet, i&, n&(0 To 12), m%
        If Target.Row = 1 And Target.Column = 5 Then
            For i = 0 To 12
                Set w(i) = Worksheets(i + 1)
                If i > 0 Then
                    w(i).Range(w(i).Cells(4, 1), w(i).Cells(Rows.Count, 9)).ClearContents
                    n(i) = 4
                Else
                    n(i) = WorksheetFunction.Max(4, w(i).Cells(Rows.Count, 1).End(xlUp).Row + 1)
                End If
            Next i
            For i = 4 To n(0)
                m = Month(w(0).Cells(i, 3))
                w(0).Rows(i).Copy Destination:=w(m).Cells(n(m), 1)
                n(m) = n(m) + 1
            Next i
        End If
    End Sub

Remarque : Si le code est aussi 'compact' c'est que vous avez eu la bonne idée de créer les feuilles dans l'ordre logique : dans l'explorateur vba on voit que la feuille source est la Feuil1, la janvier est la Feuil2, la février la Feuil3 etc. jusque décembre la Feuil13. Si pour une raison vous deviez supprimer des feuilles et les re-créer, maintenez ce nommage. Dans l'explorateur vba cliquer sur la feuille, appuyer sur F4 pour faire apparaitre la fenêtre propriété et changer au besoin la valeur de la propriété (Name) pour garder cette logique. Cordialement

Jules

Bonjour le Forum!

Salut à toi Jules237 ;

La fonction marche trés bien je te remercie pour ton aide. A bientôt

Hosni