Création TCD à partir de données filtrées

Bonjour forum,

Je voudrais savoir s'il est possible de créer un TCD en VBA à partir de données filtrées.

J'ai essayé de jouer avec les SpecialCells(xlCellTypeVisible) mais rien de probant.

Merci d'avance pour votre aide.

Salut le forum

Vba-new essaye en filtrant vers un autre emplacement, et fais ton TCD à partir de tes données extraites.

Mytå

Salut Mytå,

C'est une bonne idée mais en fait je suis susceptible de faire un TCD sur une feuille parmi une quarantaine! Au choix!

Donc je ne pense pas que ça irait!

Peut-être la mise en place d'une feuille temporaire?

Bonjour,

Pourquoi ne pas filtrer dans ton TCD plutôt que de passer vers un autre emplacement. Cela te laisserais plus de choix éventuel.

A te relire

Dan

Bonjour Dan, forum,

En fait, je ne m'y connais pas trop en TCD, donc je ne sais pas ce qu'il est possible ou pas, de faire.

En l'occurrence, le critère de filtrage ne se trouve pas dans le TCD.

Je vous montre un exemple dans le fichier suivant : https://www.excel-pratique.com/~files/doc2/suivi_commande_forum.zip

Dans la feuille "602", j'ai filtré les données selon le critère "encre".

En créant mon TCD, j'aimerais qu'il ne se fasse que sur les données non masquées.

Quand tu parles de filtrer le TCD directement, je peux entrer le critère "encre" et ça me filtre le TCD?

Merci encore d'avance pour votre aide.

Re à tous,

Je fais partager ma solution qui passe par une feuille temporaire :

Option Explicit
Sub triTCD()
Dim derLigTCD As Long, coul As Long
Dim nomClasseur As String, nomOnglet As String

    On Error GoTo triTCD_Error

    Randomize
    Application.ScreenUpdating = False
    nomClasseur = ThisWorkbook.Name    'nom de ce classeur
    nomOnglet = ActiveSheet.Name    'nom de l'onglet actif
    derLigTCD = Range("A65536").End(xlUp).Row
    'Sheets("TCD").Cells.Delete    'supprime le TCD existant

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("TCD").Delete
    Sheets.Add before:=Sheets(1)
    ActiveSheet.Name = "TCD"
    coul = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    Cells.Interior.Color = coul

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Temp$").Delete
    Sheets.Add
    ActiveSheet.Name = "Temp$"
    Sheets(nomOnglet).Range("A1:G" & derLigTCD).SpecialCells(xlCellTypeVisible).Copy [A1]

    ' création d'un TCD à partir de n'importe quelle feuille
    With ThisWorkbook.PivotCaches

        'création du premier TCD (par Numéro de compte)
        .Add(SourceType:=xlDatabase, SourceData:= _
             "Temp$!R1C1:R" & Sheets("Temp$").Range("A65536").End(xlUp).Row & "C7").CreatePivotTable TableDestination:= _
             "'[" & nomClasseur & "]TCD'!R3C1", TableName:="TCDparCpte", _
             DefaultVersion:=xlPivotTableVersion10

        'création du second TCD (par Tiers)
        .Add(SourceType:=xlDatabase, SourceData:= _
             "Temp$!R1C1:R" & Sheets("Temp$").Range("A65536").End(xlUp).Row & "C7").CreatePivotTable TableDestination:= _
             "'[" & nomClasseur & "]TCD'!R3C9", TableName:="TCDparTiers", _
             DefaultVersion:=xlPivotTableVersion10
    End With
    With ThisWorkbook.Sheets("TCD")

        'définition de la disposition du premier TCD
        With .PivotTables("TCDparCpte")
            .AddFields RowFields:=Array("n°Cpt", "Tiers")
            With .PivotFields("Mt. Facture")
                .Orientation = xlDataField
                .Caption = "Montant"
                .Function = xlSum
                .NumberFormat = "#,##0.00 €"
            End With
        End With

        'définition de la disposition du second TCD
        With .PivotTables("TCDparTiers")
            .AddFields RowFields:=Array("Tiers", "n°Cpt")
            With .PivotFields("Mt. Facture")
                .Orientation = xlDataField
                .Caption = "Montant"
                .Function = xlSum
                .NumberFormat = "#,##0.00 €"
            End With
        End With
        .Activate
        Cells.SpecialCells(xlCellTypeBlanks).Interior.Color = coul
        .PivotTables("TCDparCpte").PivotSelect ""
        .PivotTables("TCDparCpte").Format xlReport6    'définit le type de TCD
        .PivotTables("TCDparTiers").PivotSelect ""
        .PivotTables("TCDparTiers").Format xlReport6    'définit le type de TCD
    End With

    With Cells
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With

    Range("A4").Select
    ActiveWindow.FreezePanes = True    'fige les volets
    Application.DisplayAlerts = False
    Sheets("Temp$").Delete
    On Error GoTo 0
    Exit Sub
triTCD_Error:

    MsgBox "Erreur " & Err.Number & " (" & Err.Description & ") dans la procédure triTCD du Module Module1"
End Sub

Code à coller dans un module.

Si quelqu'un voit une possible optimisation du code, je suis tout ouïe

J'attends un peu avant de mettre le résolu.