Ajout de fonction SOMME

Bonjour à tous !

J'aimerai modifier mon code VBA ci-dessous afin qu'à chaque fin de mois pour la colonne "Date de publication" s'ajoute une fonction "SOMME" au bas de la colonne "Total H.T" "Facture total" et "Commission"

Nota Bene: Ce tableau est prédestiné à être rempli tous les mois, donc une fonction prévoyant qu'à la fin de janvier, fevrier, mars, avril... cela s'ajoute même si, pour l'instant, ces mois-là n'apparaissent pas sur le tableau.

Merci d'avance !

Option Explicit

Public Sub cmdCreateWorksheets_Click()
'Declaration des variables
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim lRow As Long
    'Optimisation du code
    With Application
        .DisplayAlerts = False
        '.EnableEvents = False
        .ScreenUpdating = False
    End With
    'Suppression des feuilles sauf la feuille active (feuille Donnees)
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then ws.Delete
    Next ws
    'Initialisation des varialbes
    Set ws = ActiveSheet    'Feuilles Donnees
    Set lo = ws.ListObjects(1)    'Tableau feuille Données (Excel 2007+)

    If lo.ShowAutoFilter Then
        If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
    Else
        lo.ShowAutoFilter = True
    End If
    'Creation feuille temporaire (qui sera supprimée en fin de procédure)
    'La feuille va recevoir la liste des valeurs uniques de la colonne 8 (Field Num)
    Set ws2 = ActiveWorkbook.Worksheets.Add
    With ws2
        lo.ListColumns(6).Range.AutoFilter field:=6, Criteria1:="<>"
        lo.ListColumns(9).Range.AutoFilter field:=9, Criteria1:="<>"
        lo.ListColumns(9).Range.AutoFilter field:=10, Criteria1:="="
        lo.ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
        .Cells(1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Cells(1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
        'Nombre de valeurs uniques du filtre avancé
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        'Pour chaque élément de la liste unique (Edition)
        For Each Cell In .Range("A1:A" & lRow)
            'On effectue le filtrage suivant l'item
            lo.Range.AutoFilter field:=8, Criteria1:="=" & Cell.Value
            'On crée la nouvelle feuille qui va recevoir les données filtrées
            Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            'On nomme la nouvelle feuille avec la valeur de l'élément
            WSnew.Name = IIf(Len(Cell) > 31, Left(Cell, 20) & "...." & Right(Cell, 7), Cell.Value)
            'On copie la plage filtrée (tableau feuille Données)
            lo.Range.SpecialCells(xlCellTypeVisible).Copy
            With WSnew
                With .Cells(1)
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial xlPasteValuesAndNumberFormats
                End With
                Application.CutCopyMode = False
                .Columns("A:E").Delete shift:=xlToLeft
                'On crée un nouveau tableau (Excel 2007+)
                Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(1).CurrentRegion, , xlYes)
                With lo2
                    'On détermine le style du tableau
                    .TableStyle = "TableStyleLight1"
                    .ShowTotals = True
                    .ListColumns(5).TotalsCalculation = xlTotalsCalculationSum
                End With
                'Ono active la nouvelle feuille la mise en forme (minimale)
                .Activate
                .Cells(1).Select
                ActiveWindow.DisplayGridlines = False
            End With
        Next Cell
    End With

    lo.AutoFilter.ShowAllData
    'On supprime la feuille temporaire
    ws2.Delete
    'On active la feuille Données
    ws.Activate

    MsgBox "Terminé"

    With Application
        .DisplayAlerts = True
        '.EnableEvents = True
    End With
    'On réinitialise les variables (on vide la mémoire)
    Set lo = Nothing
    Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing

End Sub

Bonjour,

Ce que tu demandes est sans aucun doute possible via VBA (poser des sous-totaux automatiques ?), mais il y a peut-être une autre solution à explorer : les TCD (tableaux croisés dynamiques). Elle est facile, puissante, rapide, et ne modifie pas ton tableau de données, ce qui fait qu'à chaque saisie, il n'y a rien d'autre à faire qu'actualiser le TCD...

De plus, sur des tableaux d'une certaine longueur, les sous-totaux intermédiaires peuvent ne pas être tous visibles, et peuvent perturber les filtres et les tris... Avec les TCD, on choisit de voir le détail ou les synthèses dans des feuilles distinctes...

As-tu exploré les fonctionnalités "tableaux croisés dynamiques" ?

Cordialement, Daniel

Bonjour,

Mon tableau a déjà une mise en forme Excel 2007+, j'ai peur que, en créant un TCD, ma macro ne fonctionne plus (je ne veux pas un second tableau sur une seconde page distincte, je n'en vois pas l'intérêt).

De plus, je n'en ai jamais crée auparavant donc j'ignore tout des fonctionnalités proposées.

Bien à vous,

Le fait d'avoir un tableau de bord sur une feuille séparée n'est pas une absurdité totale, et surtout présente beaucoup d'avantages, ceux que j'ai déjà mentionnés plus un certain nombre d'autres, parmi lesquels la certitude que les macros impactant les données vont continuer à fonctionner, puisque on ne touche pas aux données.

Ceci dit, la découverte des TCD a souvent pour effet un changement assez radical (et définitif) dans l'utilisation d'Excel, tant les solutions qu'ils apportent sont spectaculaires et impossibles ou difficiles à obtenir autrement. Cela semblait être le cas du problème que tu poses.

Mais chacun voit midi à sa fenêtre...

Cordialement, Daniel

Ah, c'était ce dont je craignais - que mes données soient impactées.

Mais si tel ne semble pas être le cas, je vais me renseigner sur la création de TCD.

Je retournerai vers vous au cas où je rencontrerai des difficultés (ce qui risque d'être le cas!)

Donc, me revoilà (haha)

Dans mon TCD, j'aimerai avoir seulement la SOMME pour "Commission" "Total HT" et "Facture Total" à chaque fin de mois.

Seulement, je n'arrive pas à les avoir "par mois"

J'ai mis en place un code VBA afin d'automatiser mon TCD en fonction de mes données:

Option Explicit

Private Sub Worksheet_Activate()
    Me.PivotTables(1).PivotCache.Refresh
    MsgBox "Le TCD a été actualisé.", vbInformation
End Sub

Voilà :

Deux ou trois petites choses :

• sur les dates en étiquettes de lignes : bouton droit / grouper
• sur les champs Valeurs : personnalisation des noms, des formats de nombres...
• sur les options du TCD (bouton droit dans le TCD / Options : décocher Ajuster automatiquement...

A+ Daniel

PS : on peut aussi faire des graphes, et d'autres stat tous azimuts !

Daniel, je te suis reconnaissante pour ton aide si précieuse.

D'autant plus que tu ne t'es pas contenté de me donner la solution, tu m'as expliqué la façon dont il fallait procéder.

Merci !

Avec plaisir !

Par contre, lorsque j'active mon bouton de contrôle (et donc ma macro initiale), mon TCD disparaît... Une explication ?

Joins ton fichier, STP

Voici

Normal, tu commences par supprimer toutes les feuilles...

Dans ce cas, il vaudrait mieux regénérer le TCD via la macro...

Qu'entends-tu par "regénérer le TCD via la macro" ?

Ecrire, à la suite de ta macro, un code qui recréé le TCD de A à Z. Cela doit pouvoir se faire avec l'enregistreur de macro.

Oooooh, catastrophe.

Ah, c'est pas toi qui a écrit la macro ?

Pas entièrement non ! J'avais fait quelque chose de bien plus simple et de bien moins précis

Il pourrait suffire de changer une ligne :

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "données" [b]And ws.Name <> "TCD"[/b] Then ws.Delete
    Next ws

A essayer ...

Il ne connaît pas le nom "Données" mais seulement "ActiveSheet.Name" (vu que dans mon code, il s'agit du "ActiveSheet lorsque l'on désigne la feuille Données)

Devrai-je sûrement ouvrir un nouveau sujet à ce propos, non ? (Il n'y a encore rien à ce sujet dans le forum)