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...
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 !