Tableau croisé dynamique - DataSource Variable - plage de destination vari

Bonjour,

Je développe en ce moment un programme afin d'automatiser la construction d'un certain nombre de TCD (le nombre varie entre 0 TCD et 6 TCD) à partir des feuilles disponibles dans un classeur. Ce classeur qu'on appellera "nouveauclasseur" est le résultat d'une recherche à partir d'un numéro de Série.

En effet, Dans un classeur initial :
Nous devons déposé le ou les numéros de séries. ==> La macro effectue dans un premier temps une recherche sur 6 classeurs (6 BDD) et extrait les lignes concernées, si elles existent, dans le "nouveauclasseur" sur 1 à 6 feuilles.

Ainsi, dans le "nouveauclasseur" peut contenir 0 feuilles comme il peut contenir 6 feuilles ==> ces feuilles portent toutes des noms différents selon la variable prédéfinie "NomNouvelleFeuille".

Pour développer le "nouveauclasseur" J'utilise une boucle For Each comme le montre le code ci après qui montre une première méthode (+ Classeur qui montre une seconde avec les macros enregistrés)

je souhaite développer pour chaque feuille existante dans le "nouveauclasseur" une feuille "TCD_nomNouvelleFeuille" qui contiendra un TCD précis.

J'ai utilisé plusieurs méthodes dont l'enregistreur de macro mais je bloque toujours lorsque je souhaite créer le PivotCaches ==> J'ai une erreur d'exécution 5 qui s'affiche.

Cependant je sais qu'il faut utiliser la concaténation pour que la plage de cellule ne soit pas fixe car dans chaque feuille du classeur on peut avoir 1 ligne comme on peut avoir 100.

Je vous remercie pour votre retour

FICHIER - Methode 1 :

CODE - Methode 2 :

Sub filtreAvancee()

traiterDossierDonnees ThisWorkbook.Path & "\ADP"

End

Static Sub traiterDossierDonnees(cheminDossier As String, Optional ByVal tcdNom As String = "Tableau croisé dynamique 1")

Dim fs As Object

Dim fichier As Object

Dim dossierDonnees As Object

Dim classeurDonnees As Workbook

Dim nouveauClasseur As Workbook

Dim feuille As Worksheet

Dim nomNouvelleFeuille As String ' Définir la nouvelle variable nomFeuilleTCD qui servira à créer la nouvelle feuille

Dim NomFeuilleTCD As String Dim plageCritere As Range Dim plageDonnees As Range

Dim tcd As PivotTable, tcdCache As PivotCache

Dim sRngStart As String, sRngAddress As String

Dim plageDestination As Range

'le chemin

Set fs = CreateObject("Scripting.FileSystemObject") Set dossierDonnees = fs.getFolder(cheminDossier)

'creer un nouveau classeur

Set nouveauClasseur = Workbooks.Add

'traitement des fichiers

Application.ScreenUpdating = False

'Début du copie collage des fichiers sources vers le nouveau classeur

For Each fichier In dossierDonnees.Files

Set classeurDonnees = Workbooks.Open(fichier.Path, True, True)

'Recuperer le nom des classeurs

nomNouvelleFeuille = fs.getBaseName(fichier.Path)

nouveauClasseur.Worksheets.Add.Name = "TCD_" & nomNouvelleFeuille

NouveauClasseur.Worksheets.Add.Name = nomNouvelleFeuille

'filtre avancé et copie sur les nouvelles feuilles

Set plageCritere = ThisWorkbook.Worksheets("contrat").Range("A1").CurrentRegion

Set plageDonnees = classeurDonnees.Worksheets(1).Range("A1").CurrentRegion

Set plageDestination = nouveauClasseur.Worksheets(nomNouvelleFeuille).Range("A1")

plageDonnees.AdvancedFilter xlFilterCopy, plageCritere, plageDestination

Set plageDestination = nouveauClasseur.Worksheets(nomNouvelleFeuille).Range("A1").CurrentRegion

' Plage de la source de données

sRngAddress = nouveauClasseur.Worksheets(nomNouvelleFeuille).Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1, External:=True)

' Cellule où insérer le tcd

sRngStart = nouveauClasseur.Worksheets("TCD_" & nomNouvelleFeuille).Range("A1").Address(ReferenceStyle:=xlR1C1, External:=True)

' Créer le cache du tcd

Set tcdCache = classeurDonnees.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=sRngAddress). _ CreatePivotTable( _ TableDestination:=sRngStart, _ TableName:=tcdNom)

' Créer le tcd à partir du cache

Set tcd = tcdCache.CreatePivotTable(TableDestination:=sRngStart, _ TableName:=tcdNom)

'verification resultat dans le nouvel emplacement

If plageDestination.Rows.Count < 2 Then

Application.DisplayAlerts = False

nouveauClasseur.Worksheets(nomNouvelleFeuille).Delete

NouveauClasseur.Worksheets("TCD_" & nomNouvelleFeuille).Delete

classeurDonnees.Saved = True

classeurDonnees.Close

Next fichier

nouveauClasseur.Activate nouveauClasseur.Worksheets("Feuil1").Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

Bonjour CharifB

Ce qui serait bien également, c'est de nous donner 1 ou 2 fichiers avec les données anonymes

A+

bonjour,

créer un TCD dans un nouveau fichier n'est pas plus compliqué que ceci

* datasource variable = NouvelleFeuille.Range("A1").CurrentRegion

* plage destionation variable = NouvelleFeuille.Range("G1")

Sub Début_TCD()
     Dim NouveauClasseur, NouvelleFeuille, TCD_1

     Sheets("Blad1").Copy 'copier la feuille "blad1" vers un nouveau Classeur
     Set NouveauClasseur = ActiveWorkbook     'votre nouveau classeur
     Set NouvelleFeuille = ActiveSheet    'votre nouvelle feuille

     'créer un TCD, qui s'appèle "TCD_1" dans G1 de cette NouvelleFeuille
     NouveauClasseur.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NouvelleFeuille.Range("A1").CurrentRegion, Version:=8).CreatePivotTable TableDestination:=NouvelleFeuille.Range("G1"), TableName:="TCD_1", DefaultVersion:=8
     Set TCD_1 = NouvelleFeuille.PivotTables("TCD_1") 'tester l'existence de TCD_1

     MsgBox "et le reste pour ce TCD ...."

End Sub

Bonjour à tous,
Comme préconisé par notre modérateur préféré , je pense que des fichiers sont nécessaires, pour une aide adaptée.
Sinon, l'option Power Query & TCDs devrait être envisagée.
Cdlt.