Duplication fichier

Bonjour à tous,

J'aurai besoin d'une petite aide. J'ai créer une macro pour dupliquer des fichiers à l'aide d'un TCD. La macro fonctionne bien.

J'aimerai maintenant ajouter un deuxième TCD ("Tableau croisé dynamique2") et c'est là mon problème...Comment faire pour que le filtre du 2e TCD soit identique à celui du 1er TCD quand les bases des 2 TCD sont différentes ?

Merci beaucoup pour votre aide,

Ci-dessous la macro :

Sub Création_Fichiers()

Application.ScreenUpdating = False

Dim TCD As PivotTable

Dim Fld As PivotField

Dim Itm As PivotItem

Dim FeSyn As Worksheet

Dim ClNew As Workbook

Dim LienFichier As String

Dim NomEts As Range

Dim CelsDate As Range

Dim Période As String

LienFichier = ThisWorkbook.Path & "\Pièces jointes\"

Set FeSyn = ThisWorkbook.Sheets("TCD")

Set TCD = FeSyn.PivotTables("Tableau croisé dynamique1")

Set Fld = TCD.PivotFields("Dpers")

Application.DisplayAlerts = False

For Each Itm In Fld.PivotItems

On Error Resume Next

Fld.CurrentPage = Itm.Name

If Err <> 0 Then GoTo Suivant

With ThisWorkbook.Sheets("Trame")

.Copy

Set ClNew = ActiveWorkbook

With ClNew

With .Sheets(1)

.Range("a1:w100").Copy

.Range("a1").PasteSpecial xlValues

.Range("a1").Select

End With

.SaveAs LienFichier & Itm.Name & (" ") & Cells(4, 2) & " Données OSR" & ".xlsx"

.Close False

End With

End With

Suivant:

Next Itm

Application.DisplayAlerts = True

End Sub

bonjour

1/

pourquoi une macro ?

un TCD se crée 1 unique fois au départ, avec clavier/souris, ensuite il suffit de le mettre à jour (d'un simple clic droit)

2/

un TCD ne duplique pas un fichier, un TCD analyse ou synthétise des données

(quoique je les utilises aussi comme simple filtre automatique, ce qui est un peu une duplication partielle de données )

3/

ajoute un segment (slicer) pour filtrer tes TCD et regarde dans les propriété du segment pour filtrer 2 TCD d'un coup.

Bonjour,

Merci de joindre un petit fichier représentatif qui nous permettra de t'apporter une aide adaptée.

Cdlt.

Oui bien sur voici le fichier.

Pour résumer :

La boucle de la macro actuelle sélectionne déjà le filtre du TCD1 appelé "Tableau croisé dynamique1". Cf onglet "TCD"

Je cherche à faire comprendre à VBA que je souhaite également qu'il modifie (en même temps) le filtre du TCD2 appelé "Tableau croisé dynamique2".

Je reste connecté si vous avez des questions. Un grand merci pour ceux qui pourront m'aider...

10test.xlsm (62.10 Ko)

bonjour

1/

pourquoi une macro ?

un TCD se crée 1 unique fois au départ, avec clavier/souris, ensuite il suffit de le mettre à jour (d'un simple clic droit)

2/

un TCD ne duplique pas un fichier, un TCD analyse ou synthétise des données

(quoique je les utilises aussi comme simple filtre automatique, ce qui est un peu une duplication partielle de données )

3/

ajoute un segment (slicer) pour filtrer tes TCD et regarde dans les propriété du segment pour filtrer 2 TCD d'un coup.

Merci JMD mais le problème avec les slicers c'est que les données de base restent présentes et modifiables.

L'idée avec ma macro est de copier les données des TCD sur une feuille appelé ici "Trame" et d'enregistrer cette feuille "Trame" dans un nouveau fichier. Pour cela j'ai fait une boucle. Cette partie de la macro fonctionne.

Ce que je n'arrive pas à faire comprendre à VBA est de sélectionner le même filtre "Dpers" sur les 2 TCD ("Tableau croisé dynamique1" et "Tableau croisé dynamique2") qui ont des bases de données différentes. Comment faire pour que ma boucle sélectionne le même "Dpers" sur les deux TCD en même temps ? Quelqu'un aurait une idée ?

Merci beaucoup !

Est-ce assez clair ? ou impossible ?

Bonjour,

Pour le principe. Je ne garantis pas les résultats.

Cdlt.

Sub Création_Fichiers()
Dim TCD As PivotTable, TCD2 As PivotTable
Dim strFld As String
Dim Itm As PivotItem
Dim FeSyn As Worksheet
Dim ClNew As Workbook
Dim LienFichier As String

    Application.ScreenUpdating = False

    LienFichier = ThisWorkbook.Path & "\Pièces jointes\"
    Set FeSyn = ThisWorkbook.Sheets("TCD")
    Set TCD = FeSyn.PivotTables("Tableau croisé dynamique1")
    Set TCD2 = FeSyn.PivotTables("Tableau croisé dynamique2")
    strFld = "Dpers"

    Application.DisplayAlerts = False

    For Each Itm In TCD.PivotFields(strFld).PivotItems
        On Error Resume Next
        TCD.PivotFields(strFld).CurrentPage = Itm.Name
        TCD2.PivotFields(strFld).CurrentPage = Itm.Name
        If Err <> 0 Then GoTo Suivant
        With ThisWorkbook.Sheets("Trame")
            .Copy
            Set ClNew = ActiveWorkbook
            With ClNew
                With .Sheets(1)
                    .Range("a1:w100").Copy
                    .Range("a1").PasteSpecial xlValues
                    .Range("a1").Select
                End With
                .SaveAs LienFichier & Itm.Name & " " & Cells(4, 2) & " Données OSR" & ".xlsx"
                .Close False
            End With
        End With
Suivant:
    Next Itm

    Application.DisplayAlerts = True

End Sub

super !! merci beaucoup !

Rechercher des sujets similaires à "duplication fichier"