Bonjour à tous,
Je cherche a effectué une macro qui sélectionne plusieurs valeurs voici ce que j'ai trouvé, mais la macro filtre les éléments un part un et ce n'est pas ce que je cherche:
Sub CreerTCD()
Dim wbk As Workbook
Dim PTCache As PivotCache
Dim PTable As PivotTable
Dim PField As PivotField
Dim PRange As Range
Dim LastRow As Long
Dim FiltresSheet As Worksheet
Dim FiltresRange As Range
Dim Comptes() As Variant
Dim Compte As Variant
' Définir le classeur actif
Set wbk = ThisWorkbook
' Vérifier si la feuille "Data" existe dans le classeur
On Error Resume Next
Set FiltresSheet = wbk.Sheets("Data")
On Error GoTo 0
If FiltresSheet Is Nothing Then
MsgBox "La feuille 'Data' n'a pas été trouvée dans le classeur. Assurez-vous que la feuille contient les comptes d'EXPEDITEUR.", vbExclamation
Exit Sub
End If
' Récupérer la plage de comptes depuis la feuille "Data"
Set FiltresRange = FiltresSheet.Range("b4:B" & FiltresSheet.Cells(FiltresSheet.Rows.Count, "B").End(xlUp).Row)
' Mettre les comptes dans un tableau
Comptes = FiltresRange.Value
' Effacer la feuille TCD EXP
wbk.Sheets("TCD EXP").Cells.Clear
' Trouver la dernière ligne de données dans la feuille "Donnée"
LastRow = wbk.Sheets("Donnée").Cells(wbk.Sheets("Donnée").Rows.Count, "A").End(xlUp).Row
' Définir la plage de données source pour le TCD (ajustez la plage selon vos besoins)
Set PRange = wbk.Sheets("Donnée").Range("A1:AM" & LastRow)
' Créer un nouvel objet PivotCache pour les données
Set PTCache = wbk.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
' Créer un nouvel objet PivotTable à partir du PivotCache
Set PTable = PTCache.CreatePivotTable(TableDestination:=wbk.Sheets("TCD EXP").Range("A1"), TableName:="TCD")
' Ajouter des champs au TCD (ajustez les champs en fonction de vos besoins)
Set PField = PTable.PivotFields("NOM RECH")
PField.Orientation = xlRowField
Set PField = PTable.PivotFields("RECEPISSE")
PField.Orientation = xlDataField
PField.Function = xlCount
Set PField = PTable.PivotFields("NBR COLIS")
PField.Orientation = xlDataField
PField.Function = xlSum
Set PField = PTable.PivotFields("POIDS REEL")
PField.Orientation = xlDataField
PField.Function = xlSum
' Ajouter le champ "Service" comme filtre
Set PField = PTable.PivotFields("Service")
PField.Orientation = xlPageField
' Boucle pour appliquer les filtres aux comptes d'EXPEDITEUR
For Each Compte In Comptes
' Filtrer le champ "EXPEDITEUR" en fonction du compte actuel
Set PField = PTable.PivotFields("NOM RECH")
PField.ClearAllFilters
' Appliquer un filtre basé sur une correspondance exacte (utilisation de xlCaptionEquals)
PField.PivotFilters.Add2 Type:=xlCaptionContains, Value1:=Compte
Next Compte
' Mettre à jour le TCD
PTable.RefreshTable
End Sub
Quelqu'un pour m'aider?
Je cherche a effectué une macro qui sélectionne plusieurs valeurs voici ce que j'ai trouvé, mais la macro filtre les éléments un part un et ce n'est pas ce que je cherche:
Sub CreerTCD()
Dim wbk As Workbook
Dim PTCache As PivotCache
Dim PTable As PivotTable
Dim PField As PivotField
Dim PRange As Range
Dim LastRow As Long
Dim FiltresSheet As Worksheet
Dim FiltresRange As Range
Dim Comptes() As Variant
Dim Compte As Variant
' Définir le classeur actif
Set wbk = ThisWorkbook
' Vérifier si la feuille "Data" existe dans le classeur
On Error Resume Next
Set FiltresSheet = wbk.Sheets("Data")
On Error GoTo 0
If FiltresSheet Is Nothing Then
MsgBox "La feuille 'Data' n'a pas été trouvée dans le classeur. Assurez-vous que la feuille contient les comptes d'EXPEDITEUR.", vbExclamation
Exit Sub
End If
' Récupérer la plage de comptes depuis la feuille "Data"
Set FiltresRange = FiltresSheet.Range("b4:B" & FiltresSheet.Cells(FiltresSheet.Rows.Count, "B").End(xlUp).Row)
' Mettre les comptes dans un tableau
Comptes = FiltresRange.Value
' Effacer la feuille TCD EXP
wbk.Sheets("TCD EXP").Cells.Clear
' Trouver la dernière ligne de données dans la feuille "Donnée"
LastRow = wbk.Sheets("Donnée").Cells(wbk.Sheets("Donnée").Rows.Count, "A").End(xlUp).Row
' Définir la plage de données source pour le TCD (ajustez la plage selon vos besoins)
Set PRange = wbk.Sheets("Donnée").Range("A1:AM" & LastRow)
' Créer un nouvel objet PivotCache pour les données
Set PTCache = wbk.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
' Créer un nouvel objet PivotTable à partir du PivotCache
Set PTable = PTCache.CreatePivotTable(TableDestination:=wbk.Sheets("TCD EXP").Range("A1"), TableName:="TCD")
' Ajouter des champs au TCD (ajustez les champs en fonction de vos besoins)
Set PField = PTable.PivotFields("NOM RECH")
PField.Orientation = xlRowField
Set PField = PTable.PivotFields("RECEPISSE")
PField.Orientation = xlDataField
PField.Function = xlCount
Set PField = PTable.PivotFields("NBR COLIS")
PField.Orientation = xlDataField
PField.Function = xlSum
Set PField = PTable.PivotFields("POIDS REEL")
PField.Orientation = xlDataField
PField.Function = xlSum
' Ajouter le champ "Service" comme filtre
Set PField = PTable.PivotFields("Service")
PField.Orientation = xlPageField
' Boucle pour appliquer les filtres aux comptes d'EXPEDITEUR
For Each Compte In Comptes
' Filtrer le champ "EXPEDITEUR" en fonction du compte actuel
Set PField = PTable.PivotFields("NOM RECH")
PField.ClearAllFilters
' Appliquer un filtre basé sur une correspondance exacte (utilisation de xlCaptionEquals)
PField.PivotFilters.Add2 Type:=xlCaptionContains, Value1:=Compte
Next Compte
' Mettre à jour le TCD
PTable.RefreshTable
End Sub
Quelqu'un pour m'aider?