XL 2010 Filtre VBA depuis une liste de valeurs

[ELucie]

Bonjour à tous,

Je suis actuellement dans l'optique d'automatiser certaines pratiques de mon service...
Ma problématique est la suivante :
J'ai une extraction quotidienne qui alimente mon onglet "FI_Inventaire_en_stock.
A partir de cet onglet, je souhaite :
- conserver les trois catégories suivantes : Demi produit, Lingot et Produit fini -> Code OK
- conserver les nuances présentes dans les magasins inscrits dans la feuilles "Articles" : ADPG01 APFG01 AQUN01 AREP01 -> Code OK mais seulement avec Array pour supprimer les magasins qui ne me correspondent pas. Je souhaite garder mes 4 magasins seulement !
- conserver les nuances inscrites en feuille "Articles" colonne A -> ma problématique puisque le nombre de nuances est supérieur à 200 alors faire un Array pour enlever 150 nuances est compliqué....

Comment puis-je coder cette demande ? Des sujets ont été ouverts mais reprennent à chaque fois "Array" pour exclure des valeurs trop conséquentes dans mon cas....
Mon objectif final étant de proposer deux TCD :
1 avec les catégories Demi produit, Lingot et produit fini avec le poids de chaque catégorie
1 avec le poids de chaque nuance répertoriée en feuille "Articles".

Je ne sais pas si ma demande est claire...
Je remercie tout ceux qui prendront le temps de m'aider.

 

[BOISGONTIER]

Bonjour,

Je ne suis pas sûr d'avoir compris:

Sub Filtre()
  Application.ScreenUpdating = False
  On Error Resume Next
  ActiveSheet.ShowAllData
     '--- magasins
     Tbl = Application.Transpose([magasins])
     ActiveSheet.[A1].AutoFilter Field:=3, Criteria1:=Tbl, Operator:=xlFilterValues
   '--- nuance
     Tbl = [nuance].Value
     ReDim Tbl2(1 To UBound(Tbl))
     For i = 1 To UBound(Tbl)
        Tbl2(i) =CStr(Tbl(i, 1))
     Next i
     ActiveSheet.[A1].AutoFilter Field:=4, Criteria1:=Tbl2, Operator:=xlFilterValues
End Sub

Sub Tout()
  On Error Resume Next
  ActiveSheet.ShowAllData
End Sub

Boisgontier

 

[ELucie]

Bonjour Boisgontier,

Merci pour votre réponse mais quand j'active le filtre, tout disparaît...

J'avais ce code au départ mais il ne fonctionne pas... et concerne le TCD, pas ma BDD. Ce que je souhaite c'est supprimer les lignes qui ne concernent pas les nuances présentes dans la feuille "Articles" en colonne A

Option Explicit
Sub Afficher_Tout()
Dim Pvi As PivotItem
Application.ScreenUpdating = False

With Sheets("TCD").PivotTables("Tableau crois_ dynamique1")
For Each Pvi In .PivotFields("Nuance").PivotItems: Pvi.Visible = True: Next
End With

Application.ScreenUpdating = True
End Sub

Sub Filtrer_TCD()
Dim Articles As Range
Dim Pvi As PivotItem
' Ne retenir que les occup_es de la plage A2:A100

With Sheets("Articles").Range("A2:A100")
Set Articles = .Resize(Application.CountA(.Cells))
End With

'On Error GoTo FIN
' interrompre la mise à jour écran

Application.ScreenUpdating = False

With Sheets("TCD").PivotTables("Tableau crois_ dynamique1")
For Each Pvi In .PivotFields("Nuance").PivotItems
Pvi.Visible = Not IsError(Application.Match(Pvi.Name, Articles, 0))
Next Pvi
End With
FIN:
If Err.Number > 0 Then
MsgBox "Filtrage du tableau croisé dynamique interrompu en raison de l'erreur suivante:" & vbCrLf & vbCrLf & _
Err.Description, vbExclamation, "Filtrage des articles"
Else: MsgBox "Mise à jour terminée"
End If

' Rétablir la mise à jour _cran
Application.ScreenUpdating = True

End Sub