tableau croisé dynamique

kyasteph

XLDnaute Occasionnel
Bonjour,
je voudrais créer un tableau croisé dynamique à partir de cinq onglets différents(voir le fichier joint).
Les differents champs de mon tableau se trouvent dans l'onglet "TCD".
D'apres les recherches sur la toile il me faut créer un fichier récapitulatif.Mais à vrai dire je ne sais comment m'y prendre par une macro.
NB:
-Il faut noter que d'autres onglets appartienent à mon classeur mais ne sont pas concernés par ce probleme.
-Les onglets du fichier joint sont classés dans l'ordre exact dans lequel ils se trouvent dans le classeur original sauf que entre l'onglet "JAL_AN" et "Gestion_Créancier" se trouve un autre onglet non concerné par ce probleme.

Merci de m'aider s'il vous plait.
 

Pièces jointes

  • ExempleRecap.zip
    225.7 KB · Affichages: 57

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : tableau croisé dynamique

Bonjour kyasteph,

Un essai dans le fichier joint.

.
  1. Vous ne facilitez pas le travail en plaçant les champs à recopier dans des colonnes différentes sur les tableaux :eek:.
  2. Vous ne facilitez pas le travail en plaçant la première ligne (en-têtes) des tableaux sur des lignes différentes :(.
  3. Vous ne facilitez pas le travail en omettant des libellés de champs dans certains tableaux :mad:.


C'est pourquoi, j'ai introduit des constantes dans le programma VBA pour indiquer:
  • Les feuilles à traiter.
  • Le numéro de ligne des en-têtes dans chaque feuille à traiter.
  • Les libellés des champs à recopier.

Le code est dans le module de code de la feuille "TCD".
 

Pièces jointes

  • kyasteph-Recap v1.xlsm
    495.2 KB · Affichages: 58
Dernière édition:

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
je voudrais dire un grand merci pour la réponse à mon probleme et surtout la promptitude avec laquelle vous avez répondue.
Effectivement vos remarques sont justes car tout ce que j'avais pu voir sur la toile comportait des fichiers qui avaient la meme structure et donc un peu plus "facile" à rassembler.
Mais comprenez moi je suis débutant.
En tout cas merci,la macro marche cependant j'ai quelques points qu'il me faut résoudre et je ne sais vraiment pas comment:
1)Dans l'onglet "Gestion_Créancier" ,le montant à copier est = ("Mtant TTC" - "Dt TVA") et le résultat de ce calcul doit toujours etre recopié au "Débit" dans l'onglet "TCD".
2)La macro ne doit copier dans chaque onglet que les informations des lignes dont le compte général (N°compte gle) est renseigné.
Merci de m'aider s'il vous plait.

NB:
J'avoue que le code est du haut niveau pour moi car:
-je découvre une nouvelle maniere de définir des variables(ligne 14 à 20)
-et des termes comme "Split;LBound;UBound"
Si vous pouviez m'expliquer ces termes et commenter un peu plus le code pour moi,cela me serait d'une grande utilité.
Merci d'avance.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : tableau croisé dynamique

Bonsoir kyasteph

(...) Mais comprenez moi je suis débutant. (...)
Dans ce cas, c'est plutôt à moi de me faire comprendre de vous :rolleyes:.

(...)
1)Dans l'onglet "Gestion_Créancier" ,le montant à copier est = ("Mtant TTC" - "Dt TVA") et le résultat de ce calcul doit toujours etre recopié au "Débit" dans l'onglet "TCD".
2)La macro ne doit copier dans chaque onglet que les informations des lignes dont le compte général (N°compte gle) est renseigné.
(...)

Voir les "verrues" dans le code.


(...) -je découvre une nouvelle maniere de définir des variables(ligne 14 à 20)
-et des termes comme "Split;LBound;UBound" (...)

J'ai un tout petit peu plus commenté le code notamment pour Split, Lbound et Ubound.

L'aide de VBA est, selon mon humble opinion, très bien faite. Si vous vous posez des questions sur une fonction, instruction, propriété ou méthode, surlignez dans le code le terme recherché et appuyez sur la touche de fonction F1. Ça marche très bien pour Split, Lbound et Ubound.

Edit: Pascales salutations du soir à Chris qui m'a devancé pour la touche F1 :)

Errata: la version postée ici présentait deux erreurs. Elle a été remplacée par la version v4 de ce message ICI.
 
Dernière édition:

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Grang grang merci à tous ,vous etes des "génies".c'est exactement ce que je voulais la macro marche à merveille.
Merci encore pour les explications et commentaires détaillés.
J'essaierais de me souvenir à l'avenir de la touche F1.
En tout cas vous etes tres sympa ainsi vous me faites avancer grandement dans mon projet.
Merci encore.Je considere que cette discussion est résolue
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : tableau croisé dynamique

Bonsoir kyasteph :),

(...) Grand grand merci à tous ,vous etes des "génies" (...)
Les autres certes oui! En ce qui me concerne, certes non! La preuve est dans la suite du message.


(...) Je considère que cette discussion est résolue (...)
Ah que nenni!

Le dicton "la nuit porte conseil" s'est encore une fois avéré. J'ai commis deux grosses bourdes critiques :mad:.

La première est que je n'avais pas prêté garde au fait que les tableaux pouvaient être filtrés. De ce fait si un filtre est actif, la macro ramène n'importe quoi dans l'onglet TCD. Pas bien!

La seconde est que s'il n'y a aucun N°compte gle à vide, la macro efface, sans autre forme de procès, tout le tableau résultat. Pas bien non plus!

La version v4 retire le filtre avant de copier les données et corrige les instructions permettant de supprimer du tableau final les lignes dont le N°compte gle est à vide.

Si c'est uniquement la copie des données filtrées qui vous intéresse, alors revenir ici le dire. Il faudra passer par une copie des cellules visibles.
 

Pièces jointes

  • kyasteph-Recap v4.xlsm
    501.6 KB · Affichages: 58

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
vous avez totalement compris ce que je voulais avec la version v4;mais en fait je m'étais contenté avec la v3 de retirer d'abord tous les filtres des tableaux concernés avant d'exécuter la macro.
Là je me rends compte qu'on peut toujours gagner du temps car la v4 m'en fait gagner effectivement.
Merci encore et pour moi tu es un génie.
j'ai un peu modifié le code (simplement ajouté un bout de code à la fin) car je me suis rendu compte qu'il fallait créer une colonne "Intitulé".
Jusque là elle marche mais dans la poursuite de mon travail c'est justement ce code ajouté qui ne s'exécute pas.
je viens juste de poster une nouvelle discussion intitulée"Macro s'exécutant à moitié".
voici le code:
Option Explicit

Code:
Sub Rassembler()

'Feuilles à traiter
Const cF = "JAL_AN/Gestion_Créancier/Gestion_Caisse/Gestion_Banque/JAL_OD"

'Ligne des en-têtes de chaque feuille à traiter
Const cFligneDebut = "11/9/9/11/11"

'Noms des champs à copier
Const cChamps = "N°compte gle/Mois/Date/Libellé/Débit/Crédit"

'Le & remplace ' as long', le $ remplace ' as string'
Dim i&, j&, DebLig&, Finlig&, NumCol, rep&
Dim F, FligneDebut, Champs, NomF$, sh As Worksheet
Dim rgTitre As Range, rgAcopier As Range, rgBase As Range, rgIci As Range

'Split transforme une chaine de caractères en un tableau de mots à une dimension
'le séparateur de mots est le caractère /
'indice inf du tableau résultant est toujours 0 (jamais 1)
F = Split(cF, "/")                        'tableau des noms des feuilles à traiter
FligneDebut = Split(cFligneDebut, "/")    'Tableau des n° ligne des en-têtes
Champs = Split(cChamps, "/")              'Tableau des champs à copier

'effacer précédent traitement
Sheets("TCD").Activate
Range("a1").CurrentRegion.Clear
Application.ScreenUpdating = False

'lbound(tablo,2) retourne le plus petit indice de la deuxième dimension de tablo
'ubound(tablo,1) retourne le plus grand indice de la première dimension de tablo
'ex: si DIM tablo( 0 to 4, 10 to 29) alors
'lbound(tablo,1)=0, ubound(tablo,1)=4, lbound(tablo,2)=10, ubound(tablo,2)=29
'si on traite la première dimension du tableau, on peut omettre ,1
'lbound(tablo)=0, ubound(tablo)=4
'Quand on ne connait pas à l'avance les bornes des indices d'un tableau, c'est pratique.
'Quand on ne sait plus si SPLIT donne des tableaux à base 0 ou 1, lbound et ubound
'permette de contourner cet oubli.

For i = LBound(F) To UBound(F)
  'Boucle sur les noms de feuilles à traiter
  NomF = F(i): Set sh = Sheets(NomF)
  'on ôte le filtres automatique
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  'n° ligne des en-têtes
  DebLig = FligneDebut(i)
  'recherche de la dernière ligne à copier
  Finlig = sh.Range("b" & Rows.Count).End(xlUp).Row
  If Finlig > DebLig Then
    'il y a effectivement des données à copier
    'Définir la cellule où copier les champs - on se base sur la colonne C des dates
    Set rgBase = Range("c" & Rows.Count).End(xlUp).Offset(1, -2)
    'définir la zone d'en-tête
    Set rgTitre = sh.Range(sh.Cells(DebLig, "a"), sh.Cells(DebLig, "a").End(xlToRight))
    'rétablir le filtre mais en affichant tout
    rgTitre.AutoFilter
    For j = LBound(Champs) To UBound(Champs)
      'boucle sur les champs à copier
      'on error resume next permet de continuer l'exécution si le champ cherché
      'ne se trouve pas dans la ligne des titres
      NumCol = 0
      'rechercher le numéro de colonne du champ à copier dans la ligne d'en-têtes
      On Error Resume Next
      NumCol = Application.WorksheetFunction.Match(Champs(j), rgTitre, 0)
      If NumCol > 0 Then
        'le champ a été trouvé (donc son numéro), on copie les données
        Set rgAcopier = sh.Range(sh.Cells(DebLig + 1, NumCol), sh.Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial xlPasteValues
        rgIci.PasteSpecial xlPasteFormats
      
      ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Débit" Then
        ' le champ à copier est inconnu
        '==> VERRUE 1 : feuille = "Gestion_Créancier" et Champs = "Débit"
        'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        NumCol = Application.WorksheetFunction.Match("Mtant TTC", rgTitre, 0)
        Set rgAcopier = sh.Range(sh.Cells(DebLig + 1, NumCol), sh.Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial xlPasteValues
        rgIci.PasteSpecial xlPasteFormats
        'chercher le champ "Dt TVA" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        NumCol = Application.WorksheetFunction.Match("Dt TVA", rgTitre, 0)
        Set rgAcopier = sh.Range(sh.Cells(DebLig + 1, NumCol), sh.Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial Paste:=xlPasteValues, operation:=xlPasteSpecialOperationSubtract
        
      ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Crédit" Then
        '' le champ à copier est inconnu
        '==> VERRUE 2 : feuille = "Gestion_Créancier" et Champs = "Crédit"
        'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        'on ne fait rien càd on laisse la cellule à vide
      
      Else
        'le champ à recopier n'existe pas et ne fait pas l'objet d'une VERRUE
        'on y met le texte en rouge <Champs> PAS TROUVÉ
        Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
        rgIci.Value = "Champ <" & Champs(j) & "> PAS TROUVÉ"
        rgIci.Font.Bold = True
        rgIci.Font.Color = RGB(255, 0, 0)
      End If
    Next j
    Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
    rgIci = NomF
  End If
Next i

Range("a1").CurrentRegionShrinkToFit = False
Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
Range("a1").CurrentRegion.FormatConditions.Delete
Range("a1").Resize(, UBound(Champs) - LBound(Champs) + 1).Value = Champs
Range("a1").Offset(, UBound(Champs) - LBound(Champs) + 1) = "Code JAL"
'déplacement de la dernière colonne de TCD (Code JAL) avant la colonne B
Columns(UBound(Champs) - LBound(Champs) + 2).Cut
Columns("B:B").Insert Shift:=xlToRight
Range("a1").CurrentRegion.EntireColumn.AutoFit
Range("a1").CurrentRegion.Rows(1).Interior.Color = RGB(200, 200, 200)

'VERRUE:  Suppression des lignes où N°compte gle est à vide
Set rgAcopier = Nothing
On Error Resume Next
Set rgAcopier = Range("a1").CurrentRegion.Offset(1).Columns(1).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rgAcopier Is Nothing Then
  'il y a des cellules vide, on supprime leur ligne
  rgAcopier.EntireRow.Delete
End If

'Création COLONNE Intitulé
    Range("H1") = "Intitulé"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"""",CONCATENATE(RC[-7],"" - "",(LOOKUP(RC[-7],COMPTES,INTITULE_COMPTES))))"
    Selection.Copy
    Range("H3:H" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").CurrentRegion.EntireColumn.AutoFit
    
'RANGER par N° de compte du plus petit au plus grand
Range("A1:H1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1:H1").Select
    Selection.AutoFilter
  
Range("a1").Select
Application.ScreenUpdating = True
End Sub

Merci de jeter un coup d'oeil et de m'aider svp.
 

chris

XLDnaute Barbatruc
Re : tableau croisé dynamique

Bonjour

Reste dans le même fil

Il faut ajouter la référence à la bonne feuille
Code:
'Création COLONNE Intitulé
    With Worksheets("TCD")
        .Range("H1") = "Intitulé"
        .Range("H2").FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"""",CONCATENATE(RC[-7],"" - "",(LOOKUP(RC[-7],COMPTES,INTITULE_COMPTES))))"
        .Range("H2").Copy
        .Range("H3:H" & .UsedRange.Rows.Count).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Range("H1").CurrentRegion.EntireColumn.AutoFit
       
    'RANGER par N° de compte du plus petit au plus grand
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        Finlig = .UsedRange.Rows.Count 'On peut sans doute le déduire de la partie précédente (je n'ai pas tout décodé)
        With .Sort
            .SetRange Range("A1:H" & Finlig)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
On peut aussi utiliser un activate de la feuille puis revenir à l'autre : si Application.ScreenUpdating est false
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : tableau croisé dynamique

Bonjouir à tous,

J'ai changé mon fusil d'épaule et placé les macros dans un module et utilisé in With...End With pour les "range" de la feuille "TCD". Il eût été sympathique de fournir un fichier exemple avec le TCD "Grand Journal" :rolleyes:

Bonjour chris :), néné06 :)
 

Pièces jointes

  • kyasteph-Recap v5.xlsm
    195.2 KB · Affichages: 58
Dernière édition:

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Vos différentes remarques m'ont permises d'évoluer dans le code et maintenant il marche ;voici les codes actualisés:
Code:
Option Explicit

Sub Rassembler()

'Feuilles à traiter
Const cF = "JAL_AN/Gestion_Créancier/Gestion_Caisse/Gestion_Banque/JAL_OD"

'Ligne des en-têtes de chaque feuille à traiter
Const cFligneDebut = "11/9/9/11/11"

'Noms des champs à copier
Const cChamps = "N°compte gle/Mois/Date/Libellé/Débit/Crédit"

'Le & remplace ' as long', le $ remplace ' as string'
Dim i&, j&, DebLig&, Finlig&, NumCol
Dim F, FligneDebut, Champs, NomF$, sh As Sheets
Dim rgTitre As Range, rgAcopier As Range, rgBase As Range, rgIci As Range

'Split transforme une chaine de caractères en un tableau de mots à une dimension
'le séparateur de mots est le caractère /
'indice inf du tableau résultant est toujours 0 (jamais 1)
F = Split(cF, "/")                        'tableau des noms des feuilles à traiter
FligneDebut = Split(cFligneDebut, "/")    'Tableau des n° ligne des en-têtes
Champs = Split(cChamps, "/")              'Tableau des champs à copier

'effacer précédent traitement
Sheets("TCD").Select
ActiveSheet.Unprotect "MDP"
Range("A2:H" & Rows.Count).Clear
Application.ScreenUpdating = False

'lbound(tablo,2) retourne le plus petit indice de la deuxième dimension de tablo
'ubound(tablo,1) retourne le plus grand indice de la première dimension de tablo
'ex: si DIM tablo( 0 to 4, 10 to 29) alors
'lbound(tablo,1)=0, ubound(tablo,1)=4, lbound(tablo,2)=10, ubound(tablo,2)=29
'si on traite la première dimension du tableau, on peut omettre ,1
'lbound(tablo)=0, ubound(tablo)=4
'Quand on ne connait pas à l'avance les bornes des indices d'un tableau, c'est pratique.
'Quand on ne sait plus si SPLIT donne des tableaux à base 0 ou 1, lbound et ubound
'permette de contourner cet oubli.

For i = LBound(F) To UBound(F)
  'Boucle sur les noms de feuilles à traiter
  NomF = F(i)
  'ligne des en-têtes
  DebLig = FligneDebut(i)
  'recherche de la dernière ligne à copier
  Finlig = Sheets(NomF).Range("b" & Rows.Count).End(xlUp).Row
  If Finlig > DebLig Then
    'il y a effectivement des données à copier
    'Définir la cellule où copier les champs - on se base sur la colonne C des dates
    Set rgBase = Range("c" & Rows.Count).End(xlUp).Offset(1, -2)
    For j = LBound(Champs) To UBound(Champs)
      'boucle sur les champs à copier
      'définir la zone d'en-tête
      Set rgTitre = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig, "a"), Sheets(NomF).Cells(DebLig, "n"))
      'on error resume next permet de continuer l'exécution si le champ cherché
      'ne se trouve pas dans la ligne des titres
      NumCol = 0
      'rechercher le numéro de colonne du champ à copier dans la ligne d'en-têtes
      On Error Resume Next
      NumCol = Application.WorksheetFunction.Match(Champs(j), rgTitre, 0)
'      NumCol = Application.WorksheetFunction.Match(Champs(j), rgTitre, 0)
'      On Error GoTo 0       'on rétablit la détection d'erreur
      If NumCol > 0 Then
        'le champ a été trouvé (donc son numéro), on copie les données
        Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial xlPasteValues
        rgIci.PasteSpecial xlPasteFormats
      
      ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Débit" Then
        ' le champ à copier est inconnu
        '==> VERRUE 1 : feuille = "Gestion_Créancier" et Champs = "Débit"
        'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        NumCol = Application.WorksheetFunction.Match("Mtant TTC", rgTitre, 0)
        Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial xlPasteValues
        rgIci.PasteSpecial xlPasteFormats
        'chercher le champ "Dt TVA" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        NumCol = Application.WorksheetFunction.Match("Dt TVA", rgTitre, 0)
        Set rgAcopier = Sheets(NomF).Range(Sheets(NomF).Cells(DebLig + 1, NumCol), Sheets(NomF).Cells(Finlig, NumCol))
        Set rgIci = rgBase.Offset(, j)
        rgAcopier.Copy
        rgIci.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationSubtract
        
      ElseIf NomF = "Gestion_Créancier" And Champs(j) = "Crédit" Then
        '' le champ à copier est inconnu
        '==> VERRUE 2 : feuille = "Gestion_Créancier" et Champs = "Crédit"
        'chercher le champ "Mtant TTC" (on suppose qu'il existe toujours)
        'pas de gestion du cas où il serait inexistant!
        'on ne fait rien càd on laisse la cellule à vide
      
      Else
        'le champ à recopier n'existe pas et ne fait pas l'objet d'une VERRUE
        'on y met le texte en rouge <Champs> PAS TROUVÉ
        Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
        rgIci.Value = "Champ <" & Champs(j) & "> PAS TROUVÉ"
        rgIci.Font.Bold = True
        rgIci.Font.Color = RGB(255, 0, 0)
      End If
    Next j
    Set rgIci = rgBase.Offset(, j).Resize(Finlig - DebLig)
    rgIci = NomF
  End If
Next i

Range("a1").CurrentRegionShrinkToFit = False
Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
Range("a1").CurrentRegion.FormatConditions.Delete
Range("a1").Resize(, UBound(Champs) - LBound(Champs) + 1).Value = Champs
Range("a1").Offset(, UBound(Champs) - LBound(Champs) + 1) = "Code JAL"
'déplacement de la dernière colonne de TCD (Code JAL) avant la colonne B
Columns(UBound(Champs) - LBound(Champs) + 2).Cut
Columns("B:B").Insert Shift:=xlToRight
Range("a1").CurrentRegion.EntireColumn.AutoFit
Range("a1").CurrentRegion.Rows(1).Interior.Color = RGB(200, 200, 200)

'VERRUE:  Suppression des lignes où N°compte gle est à vide
Set rgAcopier = Nothing
On Error Resume Next
Set rgAcopier = Range("a1").CurrentRegion.Offset(1).Columns(1)
Set rgAcopier = rgAcopier.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rgAcopier Is Nothing Then
  'il y a des cellules vide, on supprime leur ligne
  rgAcopier.EntireRow.Delete
End If

'Création COLONNE Intitulé
    Range("H1") = "Intitulé"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"""",CONCATENATE(RC[-7],"" - "",(LOOKUP(RC[-7],COMPTES,INTITULE_COMPTES))))"
    Selection.Copy
    Range("H3:H" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").CurrentRegion.EntireColumn.AutoFit
    
'RANGER par N° de compte du plus petit au plus grand
Range("A1:H1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("TCD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1:H1").Select
    Selection.AutoFilter

Range("a1").Select
Application.ScreenUpdating = True
ActiveSheet.protect "MDP"
End Sub

ET le second:

Code:
Sub ActualiserGrdLivre()
'
' ActualiserGrdLivre Macro
'
' Touche de raccourci du clavier: Ctrl+g
'
 Application.ScreenUpdating = False
 Rassembler
 Sheets("Grand_Livre").Select
    Range("A9").Select
    ActiveSheet.Unprotect "MDP"
    ActiveSheet.PivotTables("Grand Livre des comptes").PivotCache.Refresh
    ActiveSheet.Protect "MDP"

End Sub

Ces deux codes marchent à merveille;mais lorsque le "tableau croisé dynamique" (feuille "Grand_Livre") est protégé ;je ne peux pas l'exploiter en voulant utiliser le filtre du "N° compte gle".alors qu'il faut que la feuille soit protégée pour éviter des erreurs par inattention.
Quelqu'un a t il une idée ?
Merci de m'aider svp.
 

Pièces jointes

  • kyasteph-Recap.zip
    271.7 KB · Affichages: 34

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Ayant suivi vos conseils et remarques j'ai pu résoudre mon probleme tout en restant dans le fil.
Merci encore.
NB:
Le probleme est résolu pour le code mais un nouveau est apparu:l'exploitation du tableau croisé dynamique ("Grand_Livre") sur une feuille protégée.
les détails sont expliqués dans le message ci dessus.
Merci de m'aidez svp.
 
Dernière édition:

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Apres quelques recherches sur la toile,je suis arrivé à résoudre mon probleme;voici la réponse:
Le code suivant est à inclure dans le code de la feuille"Grand_Livre"

Code:
Option Explicit
Private Sub Worksheet_Activate()
Worksheets("Grand_Livre").Unprotect Password:="MDP"
PivotTables(1).RefreshTable
With Sheets("Grand_Livre")
    .EnablePivotTable = True
    .Protect "MDP", userinterfaceonly:=True
End With
End Sub

Et dans un module standard la macro "ActualiserGrdLivre" devient

Code:
Sub ActualiserGrdLivre()
'
' ActualiserGrdLivre Macro
'
' Touche de raccourci du clavier: Ctrl+g
'
 Application.ScreenUpdating = False
 Rassembler
 Sheets("Grand_Livre").Select

End Sub

Attention il faut aussi inscrire dans le "ThisWorkbook" ceci :
Code:
Private Sub Workbook_Open()
Worksheets("Grand_Livre").Unprotect Password:="MDP"
End Sub

sinon une erreur se produit à l'ouverture du fichier signalant qu'il est impossible de modifier un tableau croisé dynamique.

Une fois de plus merci à tous.
Je souhaiterais améliorer mon TCD ("Grand livre") en incluant une formule progressive dans les champs calculés du TCD à savoir:
"Solde Débit." et "Solde Crédit."
je joint une piece jointe pour etre plus clair.

NB:je remarque aussi que mon format "date" du TCD est au format "m/j/aaaa" exemple(1/15/2013);comment le changer en j/m/aaaa ;l'exemple deviendra (15/1/2013).
j'ai tout essayé mais je n'y arrive pas.

Merci de m'aider svp.
 

Pièces jointes

  • kyasteph_TCD.zip
    230.3 KB · Affichages: 36
Dernière édition:

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Apres plusieurs recherches sur la toile;ne trouvant pas toujours de solution à mon probleme de formule progressive dans le champ calculé de mon TCD;j'ai pensé à contourner le probleme en ajoutant les colonnes "Solde Débit." et "Solde Crédit." à mon fichier recapitulatif (feuille"TCD");ainsi mon TCD(feuille "Grand_Livre") affichera directement les differents soldes progressifs débit et crédit sans passer par un champs calculé.
Mais je n'arrive pas à le faire car il faudrait améliorer la macro "Rassembler" et j'avoue que c'est un "casse tete chinois" pour moi.
J'en appelle à vos lumieres pour m'éclairer.vous trouverez une illustration de ce que je veux dans la piece jointe.
Merci de m'aidez s'il vous plait.
 

Pièces jointes

  • kyastephRecap.xlsx
    16.7 KB · Affichages: 36

kyasteph

XLDnaute Occasionnel
Re : tableau croisé dynamique

Bonjour,
Ouf...;une petite erreur s'est glissée dans mon commentaire de la piece jointe:en effet j'avais au préalable fait le tableau en A1 et donc fini le commentaire.Et apres j'ai du inserer 14 lignes pour commencer à exposer mon probleme et j'ai omis d'adapter mon commentaire;du coup des modifications s'imposent dans le commentaire:
les references de cellules "I2" et "J2" deviennent "I16" et "J16";la "ligne 5" devient "ligne 19";
les references de cellules "I3" et "J3" deviennent "I17" et "J17";la "ligne 6" devient "ligne 20".

Vous verrez cela dans la nouvelle piece jointe.

Merci de m'aider s'il vous plait.
 

Pièces jointes

  • kyastephRecapNvo.xlsx
    16.7 KB · Affichages: 46

Discussions similaires

Réponses
3
Affichages
291