XL 2016 Création de tableau dynamique croisé

VBA · 25 Avril 2018

Bonjour,
J'ai développer un code pour selectionner les données d'un excel et les met en forme dans un tableau dynamique croisé, mais j'ai une erreur au niveau du nom a chaque fois.
Pouvez vous m'aider svp ?

Voici mon code

VB:

Sub TCD_échéancier()

    Der = ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row

For i = 2 To Der
    If Range("M" & i) = 0 Then
        Rows(i).Insert
        Exit For
    End If
Next

    Range("A1:N1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Feuil1!R1C1:R" & i - 1 & "C14", Version:=6).CreatePivotTable TableDestination:= _
        "Feuil2!R3C1", TableName:="Tableau croisé dynamique1", DefaultVersion:=6
    Sheets("Feuil2").Select

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "FER MON")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Article" _
        )
        .Orientation = xlDataField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Domaine" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Semaine échéancier")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Reste a livr.")
        .Orientation = xlPageField
        .Position = 1
    End With



End Sub

J'ai aperçu sur le net de mettre sous un tableau et insérer ensuite le TCD. Mias je ne vois pas vraiment comment sa marche.
D'avance merci.

VBA · 9 Mai 2018

Sur le changement de couleur de la cellule fais pendant le filtrage

VB:

For i = 2 To Der
  If Range("A" & i).Interior.ColorIndex = 46 Then
  Rows(i).Insert
  Exit For
  End If
Next i

Staple1600 · 9 Mai 2018

Re

@VBA
Décidemment...
Actuellement ton TCD pointe sur la plage ForTCD (A1:T1029)
En dehors de la couleur, quels sont les critères qui font que tu ne prends pas en compte que ces données?
(à quoi servent les données en dessous de la ligne 1030)

PS: Les données de ton fichier ne sont pas anonymisées, non ?
Qu'en pensent PSA GROUP et O***N CE**K - U5***819 ?

J'avais pourtant précisé : fichier exemple avec des données bidons

VBA · 9 Mai 2018

Voici la maccro qui fait le filtrage.
Les données en dessous ne servent a rien, elle sont extraite depuis l'erp avec les autres.

VB:

Sub reception()
'
' trie Macro
'

'
  Rows("1:1").Select
  Selection.AutoFilter
  nbLignes = ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row  'Détermine le nombre de ligne qu'il y a dans le fichier excel
  
  
If Application.CountIf(Columns("O:O"), "GB*") > 0 Then
ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=15, Criteria1:= _
  "GB*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent6
  .PatternTintAndShade = 0
  End With
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=15
End If
If Application.CountIf(Columns("F:F"), "*TRANSPORT*") > 0 Then  'Condition si dans la colonne désignation article il y a des articles contenant le mot transport
ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "*TRANSPORT*"  'Trie et filtre tous ces articles
  Rows("2:" & nbLignes).Select  'Selectionne les articles filtrer
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2  'Les met en couleurs
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "PRESTATION*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "PRESTATION*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "PACKAGING*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "PACKAGING*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "FRAIS**") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "FRAIS*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "GESTION DE*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "GESTION DE*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "HM da*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "HM da*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "REGULARISATION*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "REGULARISATION*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "FMEC*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "FMEC*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "R&D*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "R&D*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "GESTION ADMIN*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "GESTION ADMIN*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
If Application.CountIf(Columns("F:F"), "FORFAIT LIVR*") > 0 Then
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6, Criteria1:= _
  "FORFAIT LIVR*"
  Rows("2:" & nbLignes).Select
  With Selection.Interior
  .PatternColorIndex = xlAutomatic
  .ThemeColor = xlThemeColorAccent2
  .PatternTintAndShade = 0
  End With
End If
  ActiveSheet.Range("$A$1:$X$" & nbLignes).AutoFilter Field:=6
  ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add(Range( _
  "F1:F" & nbLignes), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
  = RGB(255, 255, 153)
  With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
 

End Sub

Staple1600 · 9 Mai 2018

Re

@VBA
Avant de continuer, pourrais-tu prendre le temps de répondre au PS de mon précédent message, stp ?

VBA · 9 Mai 2018

tu as raison je vais te renvoyer un fichier bidon sa sera plus simple.
Ce fichier m'appartient.

VBA · 9 Mai 2018

Voici donc un exemple bidon.

Staple1600 · 9 Mai 2018

Re

@VBA
Peux-tu détailler concrétement (en les écrivant) les critères successifs qui font que tu garderas telle ou telle donnée,stp ?
La première partie de ton code Réception disait
Si en colonne O, les données commencent par GB alors "colorier" en telle couleur
Or il n'y avait pas de telles données dans ton fichier exemple précédent ???

PS; Données bidons, oui mais dans un fichier qui reprend la même structure (même nombre de colonnes, même entête, même format de cellule) que le fichier original
Et également les mêmes critères de "filtrage"

VBA · 9 Mai 2018

Ducoup je vais te renvoyez le fichier original.
Les critères il se base sur des designations d'article qui sont les suivant:
-*TRANSPORT*
- PRESTATION*
- PACKAGING*
- FRAIS*
- GESTION DE*
- HM da*
- REGULARISATION*
- FMEC*
- R&D*
- GESTION ADMIN*
- FORFAIT LIVR*

Pour le filtre sur la colonne O c'est tout à fait normal il n'y en pas tout le temps.

Staple1600 · 9 Mai 2018

Re

@VBA
Non, surtout pas de fichier original!!
La charte du forum indique clairement ne pas joindre de fichier avec des données confidentielles.
Tout simplement pour éviter d'éventuels problèmes juridiques pour le webmaster.

C'est pas compliquéer de créér un fichier exemple avec une trentaine de ligne
1) avec la même ligne d'entête (là pas de souci: rien de confidentiel)
2) des données fictives (mais qui peuvent correspondre au critères)
exemple
TRANSPORT TOTO TITI
REGULARISATION ABC1
etc...

VBA · 14 Mai 2018

Bonjour,
Voila un fichier exemple:

XL 2016 Création de tableau dynamique croisé

VBA

XLDnaute Nouveau

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

VBA

XLDnaute Nouveau

Pièces jointes

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

VBA

XLDnaute Nouveau

Pièces jointes

Discussions similaires