Tableau croisé dynamique

Bonjour,

Fabienne, sans vouloir m'inscruster dans ce fil mais en lisant les interventions de Nad et

Felix, je ne vois pas la finalité de ta demande.

Comme Felix, je ne vois que 3 éléments (C, D et E) dans le champ Orga2 du TCD situé dans la feuille "par collaborateur". D'où, lorsque tu dis n'utiliser que les éléments 4, 5, 6 et 7, cela correspond à quelle lettre dans ce champ (C, D, E puis A, B, F ....??) ?

Ce que tu veux faire ensuite, c'est créér un TCD à partir de 2 autres ou autre chose ?

Amicalement

Dan

Bonjour Dan.

J'ai un peu de mal à m'expliquer mais ce n'est jamais simple.

Donc je recommence.

Chaque mois, je reçois une extraction établie à partir d'une application de gestion des temps des collaborateurs.

Ceux-ci saisissent, par quart de journée minimum, leur activité par projet, client, réunion, etc...

J'ai en charge de consolider, pour une partie ces collaborateurs qui représente 4 éléments de "ORGA NIVEAU 2" un état mensuel et annuel de ces activités.

L'état mensuel ne me pose pas de problème particulier (des TCD dans tous les sens font très bien l'affaires)

C'est l'état annuel qui me pose souci car je suis obligés de faire un copier/coller des données mensuelles pour n'avoir qu'un seul fichier regroupant toutes les infos. Ce qui fait que très vite, le fichier devient très très lours (1 mois = environ 10 000 lignes)

Ce que je souhaitais donc faire, c'est établir les dynamiques à partir des 12 feuilles mensuelles de données.

Merci Dan de t'inquiéter de mon problème!

Bonjour,

Bonjour Dan

Fabienne, si je t'ai demandé le texte littéral de tes critères, c'est que je pensai extraire toutes les données de tous tes onglets, en fonction de ces critères, et ensuite, tu pourrais faire tes TCD....

Pour info, j'ai fait un test, avec 4 onglets de 10000 lignes, et une mise à jour des 3 TCD, cela prend un peu plus de 2 secondes...

Si cela t'intéresse, je peux te joindre mon ébauche, que tu pourrais adapter à ton projet.

Il y aurait pas mal de modifs à faire, dans ton projet final, mais une fois que ces modifs seraient faites, tu serais tranquille.

Re,

Bonjour Felix,

Fabienne, juste une suggestion.

Lorsque tu fais un extract mensuel, pourquoi ne pas récupérer cet extract dans un fichier qui, au final, reprend toutes les données et de là faire les TCD mensuels ou annuels ?

un hic toutefois si tu as au final trop de données dans ta feuille "Extract" et trop de données pour le TCD car là aussi il y a des limites...

Amicalement

Dan

Re-bonjour à tous

D'abord, merci!

Je veux bien l'ébauche et je verrais ce que j'arrive à en sortir.

Je n'hésiterai pas à rappeler au secours!

Ensuite, le problème, c'est que l'extract m'arrive d'une appli à laquelle je n'ai pas accès. Cela m'est fourni par notre siège social et donc je n'ai pas d'action possible à ce niveau.

Encore merci, j'attends donc le fichier.

Re-,

Pour voir le code, tu fais Alt + F11 et tu doubles cliques sur "Module 1"

dans le fichier joint, j'ai supposé que le nom de toutes les feuilles issues de l'extraction de siège social commençait par "Extract....". Sinon, il faudra modifier le code, mais le plus simple, c'est d'adopter cette méthode

Dans l'onglet "Compil", j'ai copié les titres qui t'intéressent (nota, tu avais oublié la colonne D dans ton énoncé principal...)

A partir de ces feuilles, j'extrais vers la feuille "compil" toutes les données correspondant à tes 4 critères, par cette formule :

[M2].FormulaR1C1 = _
                "=OR('" & .Name & "'!RC[-10]=""C"",'" & .Name & "'!RC[-10]=""D"",'" & .Name & "'!RC[-10]=""E"",'" & .Name & "'!RC[-10]=""F"")"

Remplaces C, D, E et F par tes critères (laisse les ""..."")

Dans ta feuille compil, tu as donc tout ce qui t'intéresse...

Ensuite, je nomme la base comme ainsi : "base2"

Pour faire tes TCD, utilise la base "base2" comme référence, et non les colonnes entières (tu multiplies la taille de ton fichier par 10, et tu augmentes le temps de traitement en utilisant les colonnes entières)

regarde, mon fichier, 116 Ko avec deux feuilles en plus, et un code en plus..

Le tien faisait plus d'1 Mo

ceci juste du aux références de tes TCD

A l'étape 2, dans la case Plage, tu cliques dedans, tu fais F3, et tu sélectionnes "base2"

Tes TCD sont mis à jour automatiquement en fin de code

Pour voir ce que ça donne, clique sur le rectangle jaune, dans la feuille "compil"

Bon courage

https://www.excel-pratique.com/~files/doc2/Fichier_pour_TCD_multi_bases_v1.zip

re,

Ensuite, le problème, c'est que l'extract m'arrive d'une appli à laquelle je n'ai pas accès. Cela m'est fourni par notre siège social et donc je n'ai pas d'action possible à ce niveau.

Regarde ce que Felix a proposé, c'est de cela dont je parlais avant à la seule différence que si l'extract est fait dans un fichier à part, on peut récupérer les données dans la feuille Compil.

Bon ap

Dan

Merci Felix!

J'essaie tout cela (il va me falloir un certain temps pour tout comprendre )

et je te tiens au courant.

Génial, en tout cas!

Merci également à Dan pour ses conseils.

Aie! je ne suis pas douée.

Il me met "erreur syntaxe".

J'envoie le code (une ligne en rouge, c'est sans doute la ligne d'erreur?)

Sub extract()

Dim DerLig As Long, Prem As Long

Application.ScreenUpdating = False

Range("A2:K65000").Delete Shift:=xlUp

For Each sh In Sheets

If Left(sh.Name, 7) = "Extract" Then

With sh

DerLig = .[A65000].End(xlUp).Row

.Range("A1:AD" & DerLig).Name = "base"

Prem = [A65000].End(xlUp).Row + 1

Range("A1:K1").Copy Cells(Prem, 1)

[M2].FormulaR1C1 = _

"=OR('" & .Name & "'!RC[-10]=""FM - Back Office Infratructure"

"",'" & .Name & "'!RC[-10]=""FM - Back Office Application"",'" & .Name & "'!RC[-10]=""FM - Pôle service"",'" & .Name & "'!RC[-10]=""FM - Service Desk"")" .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _

"M1:M2"), CopyToRange:=Range(Cells(Prem, 1), Cells(Prem, 11))

Range(Cells(Prem, 1), Cells(Prem, 11)).Delete Shift:=xlUp

End With

End If

Next sh

[M2].ClearContents

Range("A1:K" & [A65000].End(xlUp).Row).Name = "base2"

ActiveWorkbook.RefreshAll

End Sub

J'ai l'impression que le bouton n'est plus actif, mais je me trompe peut être, dis moi si je dois te renvoyer le fichier

Merci

Re,

afin de mieux voir où se situe le pb, peux-tu envoyer ton code entre les balises "codes"

En haut, sur cette page, tu clique sur Code (tu auras ceci : [code ] sans l'espace)

tu colles le code

et tu réappuies sur Code* (tu auras ceci : [\Code ]

Cette méthode permet de recopier le code tel qu'il est écrit dans un module...

Range("base") est-il sur la même ligne que la formule?

Si oui, fais un retour à la ligne devant..

A te relire

Sub extract()
Dim DerLig As Long, Prem As Long
Application.ScreenUpdating = False
Range("A2:K65000").Delete Shift:=xlUp
For Each sh In Sheets
    If Left(sh.Name, 7) = "Extract" Then
        With sh
            DerLig = .[A65000].End(xlUp).Row
            .Range("A1:AD" & DerLig).Name = "base"
            Prem = [A65000].End(xlUp).Row + 1
            Range("A1:K1").Copy Cells(Prem, 1)
            [M2].FormulaR1C1 = _
                "=OR('" & .Name & "'!RC[-10]=""FM - Back Office Infratructure"",'"
 & .Name & "'!RC[-10]=""FM - Back Office Application"",'" & .Name & "'!RC[-10]=""FM - Pôle service"",'" & .Name & "'!RC[-10]=""FM - Service Desk"")"
            .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                "M1:M2"), CopyToRange:=Range(Cells(Prem, 1), Cells(Prem, 11))
            Range(Cells(Prem, 1), Cells(Prem, 11)).Delete Shift:=xlUp
        End With
    End If
Next sh
[M2].ClearContents
Range("A1:K" & [A65000].End(xlUp).Row).Name = "base2"
ActiveWorkbook.RefreshAll
End Sub

Re,

d'après le code, tu avais un retour à la ligne de trop, dans la formule..

copie ce code, et essaie :

Sub extract()
Dim DerLig As Long, Prem As Long
Application.ScreenUpdating = False
Range("A2:K65000").Delete Shift:=xlUp
For Each sh In Sheets
    If Left(sh.Name, 7) = "Extract" Then
        With sh
            DerLig = .[A65000].End(xlUp).Row
            .Range("A1:AD" & DerLig).Name = "base"
            Prem = [A65000].End(xlUp).Row + 1
            Range("A1:K1").Copy Cells(Prem, 1)
            [M2].FormulaR1C1 = _
                "=OR('" & .Name & "'!RC[-10]=""FM - Back Office Infratructure"",'" & .Name & "'!RC[-10]=""FM - Back Office Application"",'" & .Name & "'!RC[-10]=""FM - Pôle service"",'" & .Name & "'!RC[-10]=""FM - Service Desk"")"
            .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                "M1:M2"), CopyToRange:=Range(Cells(Prem, 1), Cells(Prem, 11))
            Range(Cells(Prem, 1), Cells(Prem, 11)).Delete Shift:=xlUp
        End With
    End If
Next sh
[M2].ClearContents
Range("A1:K" & [A65000].End(xlUp).Row).Name = "base2"
ActiveWorkbook.RefreshAll
End Sub

Merciiiiiiiiiiiiiiiii!

Jusque là, tout va bien....

Je continue et te tiens au courant.

Super!!!!!!

Je n'en reviens pas, tu viens de me simplifier la vie durant au moins 3 jours par mois!!

Que te dire, sinon.........MERCI!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Re-,

et bien content que cela puisse te servir

Juste une petite question, sur ton fichier réel, combien de temps, pour exécuter le code?

Rajoute cette ligne en tout début de code (après le sub Extract())

t = Timer

et celle-ci en toute fin de procédure, avant le End Sub :

MsgBox Timer - t

tu auras un msgbox te donnant le temps d'exécution en secondes....

Bonne journée

Re!

OK, je prépare mon fichier avec les différents onglets, je modifie le code comme tu me l'indiques et je t'envoies le temps que cela a mis.

Laisse moi quelques minutes car mon patron vient de m'appeler!

Merci

RE

J'ai du faire une bétise, j'ai à nouveau un bug!

Mais, maintenant je sais te joindre le code

Sub extract()
t = Timer
Dim DerLig As Long, Prem As Long
Application.ScreenUpdating = False
Range("A2:K65000").Delete Shift:=xlUp
For Each sh In Sheets
    If Left(sh.Name, 7) = "Extract" Then
        With sh
            DerLig = .[A65000].End(xlUp).Row
            .Range("A1:AD" & DerLig).Name = "base"
            Prem = [A65000].End(xlUp).Row + 1
            Range("A1:K1").Copy Cells(Prem, 1)
            [M2].FormulaR1C1 = _
                "=OR('" & .Name & "'!RC[-10]=""FM - Back Office Infratructure"",'" & .Name & "'!RC[-10]=""FM - Back Office Application"",'" & .Name & "'!RC[-10]=""FM - Pôle service"",'" & .Name & "'!RC[-10]=""FM - Service Desk"")"
            .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                "M1:M2"), CopyToRange:=Range(Cells(Prem, 1), Cells(Prem, 11))
            Range(Cells(Prem, 1), Cells(Prem, 11)).Delete Shift:=xlUp
        End With
    End If
Next sh
[M2].ClearContents
Range("A1:K" & [A65000].End(xlUp).Row).Name = "base2"
ActiveWorkbook.RefreshAll
MsgBox Timer - t
End Sub

J'espère que ce n'est pas trop grave!

Re-,

pour moi, il n'y a pas d'erreur dans le code (du moins, pas de lignes rouges)

Par contre, as-tu bien un onglet "Compil"?

Si oui, y as-tu bien recopié les titres, comme dans l'exemple?

Ces titres sont-ils exactement les mêmes que dans les onglets "Exctract..."?

Et sinon, où s'arrête le code? Quand tu appuies sur Débogage, quelle ligne est en rouge?

On va y arriver....

J'ai renommé l'onglet copil en "base 2" donc...j'ai pas tout compris!

Faut il que je renomme l'onglet "base 2" en copil et si oui, où est ma base 2?

Est-ce une copie de l'onglet copil?

Re-,

la zone "base2" est créée automatiquement par la ligne :

Range("A1:K" & [A65000].End(xlUp).Row).Name = "base2" 

C'est à dire, que la zone qui nous intéresse va de A1 à Kxxx, xxx étant calculé par la fonction :

 [A65000].End(xlUp).Row

, c'est à dire qu'on cherche la dernière ligne remplie de la feuille

Par contre, on peut très bien appeler l'onglet compil d'un autre nom, mais il faut que le code soit lancé lorsque l'onglet "compil" (ou autre nom), soit actif, c'est à dire qu'il faut qu'il soit apparent....