Dispatcher données sur un mois choisi

Bonjour à tous,

je reviens vers vous pour solliciter votre aide concernant ma problématique de ventilation des montants.

dans le fichier ci-joint j'ai une feuille RECAP qui englobe toutes les données qui seront dispatchées dans les autres feuilles.

j'aimerais avoir un code qui me permettra lorsque je renseigne le mois souhaité dans K1 (Feuille RECAP) de :

Ventiler les données de la colonne C de la feuille Recap dans la feuille Concernée en se basant sur le code de la colonne D qui est le même nom de la feuille de destination

Ventiler les montants de la colonne E de la feuille RECAP dans le même mois que K1 dans la feuille concernée en se basant sur le code de la colonne D qui est le même nom de la feuille de destination

dans la colonne AO je dois avoir les mêmes montants copiés automatiquement comme j'ai fait manuellement en renseignant le nom du mois dans la cellule AO2

dans la colonne AP je dois avoir les montants du même mois mais de l'année précédente c'est à dire les mois qui sont entre N & Y

Exemple: dans K1 j'ai mis Juin-2018 donc dans la feuille DT par exemple les montants des colonnes C & E (feuille recap) sont mentionnés dans les colonnes C & G .

puis les mêmes données de la colonne G (feuille DT) sont mentionnées dans AO en mettant dans AO2 le nom du mois et l'année.

ensuite les données du même mois mais de l'année écoulée sont mentionnées dans AP en mettant dans AP2 le nom du mois et lannée.

NB: de préférence que les données du tableau AN: AS soit en valeur et pas en formule

Merci d'avance pour votre aide

Cordialement

An@s

Bonjour An@s, bonjour le forum,

Peut-être comme ça :

Sub Importer()
Dim R As Worksheet 'déclare la variable R (onglet RECAP)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim M As String 'déclare la variable M (Mois)
Dim A As String 'déclare la variable A (Année)
Dim J As Integer 'déclare la variable J (incrément)
Dim REF As String 'déclare la variable REF (onglet RÉFérence)
Dim I As Integer 'déclare la variable I (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim PL As Range 'déclare la variable PL (PLage)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set R = Worksheets("RECAP") 'définit l'onglet R
TV = R.Range("A1").CurrentRegion 'définit le tablesu des valeurs TV
M = Format(R.Range("K1").Value, "mmmm") 'définit le mois M
A = Format(R.Range("K1").Value, "yyyy") 'définit l'année A
J = 3 'intialise la variable J
REF = "DT" 'initialise la reférence REF
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
    Set OD = Worksheets(TV(I, 4)) 'définit l'onglet de destination OD
    Select Case A 'agit en fonction de l'année A
        Case "2017" 'cas 2017
            Set PL = OD.Range("N2:Y2") 'définit la plage PL
        Case "2018" 'cas 2018
            Set PL = OD.Range("B2:M2") 'définit la plage PL
    End Select 'fin de l'action en fonction de l'année A
    COL = PL.Find(M, , xlValues, xlWhole).Column 'définit la colonne COL (recherche le mois M dans la plage PL)
    If OD.Name <> REF Then REF = OD.Name: J = 3 'si le nom de l'onglet OD est différent de la référence REF, la référence REF devient le nom de l'onglet OD, J = 3
    OD.Cells(J, COL).Value = TV(I, 5) 'renvoie dans la cellule ligne J colonne COL de l'onglet destination, la donnée ligne I colonne 5 de TV
    J = J + 1 'incrémente J
Next I 'prochaine ligne de la boucle
End Sub

Bonjour THAUTHEME,

merci beaucoup pour la promptitude de votre réponse mais il y'a toujours des points a rajouter ou rectifier :

-dans la feuille RECAP si une nouvelle ligne est ajoutée et en cliquant sur le bouton ventilation les données des colonnes C et E se dispatchent sur la feuille concernée mais ils doivent être rajoutées à la mise en forme du tableau de la feuille de destination

-dans la colonne AO je dois avoir les mêmes montants copiés automatiquement dans le mois de la feuille de destination comme j'ai fait manuellement en renseignant le nom du mois dans la cellule AO2 automatiquement

-dans la colonne AP je dois avoir les montants du même mois mais de l'année précédente c'est à dire les mois qui sont entre N & Y

Merci encore pour votre réponse

Cordialement

Bonjour,

Une autre proposition avec les données sous forme de tableaux et des TCDs.

Avec l'idée que l'année N-1 soit traitée de la même manière (ainsi que le budget).

A te relire.

Cdlt.

Public Sub Consolidate_Data()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet, wsPT As Worksheet
Dim loData As ListObject, loTable As ListObject
Dim Cell As Range
Dim dt As Date
Dim N As Long

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("RECAP")
    dt = wsData.Cells(11).Value2
    Set loData = wsData.ListObjects(1)
    Set wsTable = wb.Worksheets("Consolidation")
    Set loTable = wsTable.ListObjects(1)
    Set wsPT = wb.Worksheets("TCD maître")

    If IsDate(dt) Then
        If Not loData.DataBodyRange Is Nothing Then
            N = loData.ListRows.Count
            With loTable
                If .InsertRowRange Is Nothing Then
                    Set Cell = .HeaderRowRange.Cells(2).Offset(.ListRows.Count + 1)
                Else
                    Set Cell = .InsertRowRange.Cells(2)
                End If
            End With
        End If
        loData.DataBodyRange.Copy
        With Cell
            .PasteSpecial xlPasteValuesAndNumberFormats
            .Offset(, -1).Resize(N).Value = dt
        End With
        Application.CutCopyMode = False
    End If

    wsPT.PivotTables(1).RefreshTable

End Sub

Re,

Désolé An@s mais j'ai rien compris à ton dernier post.

Bonjour Jean-Éric...

Re ThauThème,

merci jean-eric pour votre proposition mais je ne dois rajouté aucune feuille sur celles que j'ai dans mon classeur

*bon comme vous pouvez remarquer sur le fichier ci-joint j'ai rajouté des lignes dans la feuille RECAP et en cliquant sur votre code,

dans la feuille DT il a rajouté les montants de la colonne E mais il n'a pas ajouté les données de la colonne C dans la colonne A (feuillle DT)

d'autres part le code doit cadrer automatiquement le tableau de la feuille DT après la ventilation.

* par exemple dans la cellule AO2 de la feuille DT le mois Juin-2018 doit être écrit automatiquement et les données de la colonne AO seront les mêmes de la colonne G (feuille DT)

*dans AP2 de la feuille DT je dois juin-2017 automatiquement c'est à dire le même mois mais de l'année précédente et puis les données de la colonne AP seront les mêmes de la colonne S (feuille DT) c'est à dire juin-2017

NB: c'est pareille pour les autres feuille du classeur

Re,

Un autre essai :

Sub Importer()
Dim R As Worksheet 'déclare la variable R (onglet RECAP)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim M As String 'déclare la variable M (Mois)
Dim A As String 'déclare la variable A (Année)
Dim Ad As String 'déclare la variable Ad (Année diminuée)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLd As Range 'déclare la variable PLd (PLage diminuée)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim COLd As Integer 'déclare la variable COLd (COLonne diminuée)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL1() As Variant 'déclare la variable TL1 (Tableau des Lignes 1)
Dim TL2() As Variant 'déclare la variable TL2 (Tableau des Lignes 2)

Set R = Worksheets("RECAP") 'définit l'onglet R
TV = R.Range("A1").CurrentRegion 'définit le tablesu des valeurs TV
DL = UBound(TV, 1) 'définit la dernière ligne DL du tableau des valeurs TV
M = Format(R.Range("K1").Value, "mmmm") 'définit le mois M
A = Format(R.Range("K1").Value, "yyyy") 'définit l'Année A
Ad = A - 1 'définit l'année diminuée Ad
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    If O.Name <> R.Name Then 'condition 1 : si le nom de l'onglet de la boucle est différent du nom de l'onglet R (RECAP)
        Select Case A 'agit en fonction de l'année A
            Case "2017" 'cas 2017
                Set PL = O.Range("N2:Y2") 'définit la plage PL
                Set PLd = O.Range("B2:M2") 'définit la plage PLd
            Case "2018" 'cas 2018
                Set PL = O.Range("B2:M2") 'définit la plage PL
                Set PLd = O.Range("N2:Y2") 'définit la plage PLd
        End Select 'fin de l'action en fonction de l'année A
        COL = PL.Find(M, , xlValues, xlWhole).Column 'définit la colonne COL (recherche le mois M dans la plage PL)
        COLd = PLd.Find(M, , xlValues, xlWhole).Column 'définit la colonne COLd (recherche le mois M dans la plage PLd)
        O.Range("AO2").Value = R.Range("K1").Value 'renvoie la date en K1 dans la cellule AO2 de l'onglet O de la boucle
        O.Range("AP2").Value = DateSerial(Ad, Month(R.Range("K1").Value), 1) 'renvoie la date en K1 moins un an dans la cellule AP2 de l'onglet de la boucle O
        For I = 2 To DL 'boucle 2 : sur les lignes I du tableau des valeurs (en partant de la seconde)
            If TV(I, 4) = O.Name Then 'condition 2 : si la donnée ligne I col 4 du tableau des valeur est égale au nom de l'onglet O de la boucle
                ReDim Preserve TL1(K) 'redimensionne le tableau des lignes TL1
                ReDim Preserve TL2(K) 'redimensionne le tableau des lignes TL2
                TL1(K) = TV(I, 2) 'récupere dans la ligne K de TL1 la [Section] en colonne 2 du tableau des valeurs TV
                TL2(K) = TV(I, 5) 'récupere dans la ligne K de TL2 le [Montant] en colonne 5 du tableau des valeurs TV
                K = K + 1 'incrémente K
            End If 'fin de la condition
        Next I 'prochaine ligne de la boucle 2
        O.Range("A3").Resize(UBound(TL1), 1).Value = Application.Transpose(TL1) 'renvoie dans A3 redimensionnée de l'onglet O de la boucle, le tableau TL1 transposé
        O.Range("AO3").Resize(UBound(TL2), 1).Value = Application.Transpose(TL2) 'renvoie dans AO3 redimensionnée de l'onglet O de la boucle, le tableau TL2' transposé
        O.Cells(3, COL).Resize(UBound(TL2), 1).Value = Application.Transpose(TL2) 'renvoie dans le mois de l'onglet O de la boucle, le tableau TL1 transposé
        O.Cells(3, "AP").Resize(UBound(TL2), 1).Value = O.Cells(3, COLd).Resize(UBound(TL2)).Value 'renvoie dans AP3 redimensionnée de l'onglet O de la boucle, les données du mois précédent
        Erase TL1: Erase TL2: K = 0 'vide TL1, TL2 et réinitialise K
    End If 'fin de la condition
Next O 'prochain ongglet de la boucle
End Sub

Je ta laisse le soins de faire la mise en forme des différents tableaux...