Duplication fichier Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
l
leogigi
Membre habitué
Membre habitué
Messages : 61
Inscrit le : 15 mai 2015
Version d'Excel : 2010

Message par leogigi » 25 janvier 2018, 09:54

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
j
jmd
Fanatique d'Excel
Fanatique d'Excel
Messages : 10'599
Appréciations reçues : 250
Inscrit le : 8 décembre 2007
Version d'Excel : 365 + PowerBI

Message par jmd » 25 janvier 2018, 10:33

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 :wink: )

3/
ajoute un segment (slicer) pour filtrer tes TCD et regarde dans les propriété du segment pour filtrer 2 TCD d'un coup.
Apprenez les fonctions d'Excel.
Exemple "Mettre sous forme de tableau", TCD, "Récupérer des données".
Apprendre les fonctionnalités "récentes".
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'701
Appréciations reçues : 701
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 25 janvier 2018, 14:20

Bonjour,
Merci de joindre un petit fichier représentatif qui nous permettra de t'apporter une aide adaptée.
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
l
leogigi
Membre habitué
Membre habitué
Messages : 61
Inscrit le : 15 mai 2015
Version d'Excel : 2010

Message par leogigi » 25 janvier 2018, 14:54

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...
test.xlsm
(62.1 Kio) Téléchargé 9 fois
l
leogigi
Membre habitué
Membre habitué
Messages : 61
Inscrit le : 15 mai 2015
Version d'Excel : 2010

Message par leogigi » 25 janvier 2018, 15:01

jmd a écrit :
25 janvier 2018, 10:33
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 :wink: )

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 !
l
leogigi
Membre habitué
Membre habitué
Messages : 61
Inscrit le : 15 mai 2015
Version d'Excel : 2010

Message par leogigi » 6 février 2018, 10:19

Est-ce assez clair ? ou impossible ?
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'701
Appréciations reçues : 701
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 6 février 2018, 12:31

Bonjour,
Pour le principe. Je ne garantis pas les résultats. :oops:
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
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
l
leogigi
Membre habitué
Membre habitué
Messages : 61
Inscrit le : 15 mai 2015
Version d'Excel : 2010

Message par leogigi » 6 février 2018, 16:43

super !! merci beaucoup !
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message