Microsoft 365 VBA loop sur pivot table & pdf bug

Salut, après nettoyage, ajouts et corrections, en espérant ne rien avoir oublié, à toi de poursuivre.

Bonjour Kiki29, je te remercie pour ton aide.
le PDF est bien produit mais le produit B devrait generer un PDF avec 2 pages.
pour le produit B, les codes sont BBB et VVV donc la macro doit voir que je cree 2 pages (1 page par code) et que le resultat doit donner un PDF en 2 pages.
l'objectif de la macro est de creer un PDF par ligne de produit et chaque page doit etre specificque par Code produit.
Donc si une ligne produit a 40 references, je cherche a produire n PDF de 40 pages.

autre question qui est mon deuxieme point:
As tu compris pourquoi le PDF ne se rafraichissait pas?

Set pf1 = ActiveSheet.PivotTables("PivotTable1").PivotFields("Code")
Set pf2 = ActiveSheet.PivotTables("PivotTable2").PivotFields("Code")

pf1.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
pf2.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value

ActiveSheet.RefreshAll
ActiveSheet.Move After:=Workbooks(strDest).Sheets(1)

Le code est cense aussi rafraichir les tables donc pour produit A, j'ai la pivot table qui devrait se rafraichir et prendre TTT, ensuite pour produit B, la macro doit faire une loop sur la pivot et selectionner produit B....

merci

Bonsoir, j ai trouve le petit probleme.
Merci
le code final:

Sub create_Tab()
Dim nmB As String
Dim wsh_somme, wsh_data As Worksheet
Dim Lignes As Long, k As Long
Dim Lastfund As Long, Lastrow As Long
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim i As Long, Deb As Currency
Dim mySheet As Object
Dim strFilePath As String, strSource As String, Rng As Range, Rang As Range
Dim NewBook As Workbook, strDest As String, rangeName, strFileName As String

Deb = Timer
Application.StatusBar = ""
strFilePath = ActiveWorkbook.Path & "\" & "Output" & "\"

If CreationDossier(strFilePath) = False Then Exit Sub

strSource = ActiveWorkbook.Name

Set wsh_somme = Worksheets(shTemplate.Name)
Set wsh_data = Worksheets(shStatic.Name)

On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Lignes = wsh_data.Cells(Rows.Count, 1).End(xlUp).Row

Lastfund = shStatic.Cells(Rows.Count, 1).End(xlUp).Row

Set Rng = Application.Range("Static!A2:F" & Lastfund)

Lastrow = shStatic.Cells(Rows.Count, 11).End(xlUp).Row

If Lastrow > 1 Then
shStatic.Range("K2:K" & Lastrow) = ""
End If

shStatic.Range("F1:F" & Lastfund).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=shStatic.Range("K1"), _
Unique:=True

Lastrow = shStatic.Cells(Rows.Count, 11).End(xlUp).Row
Set Rang = shStatic.Range("K2:K" & Lastrow)

For k = 1 To Rang.Rows.Count
Set NewBook = Workbooks.Add
strDest = ActiveWorkbook.Name
rangeName = Rang.Cells(RowIndex:=k).Value

For i = 1 To Rng.Rows.Count

If Not IsEmpty(Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value) Then
If Rng.Cells(RowIndex:=i, ColumnIndex:="F").Value = rangeName Then
Workbooks(strSource).Activate
nmB = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
wsh_somme.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nmB

Set pf1 = ActiveSheet.PivotTables("PivotTable1").PivotFields("Portfolio")
Set pf2 = ActiveSheet.PivotTables("PivotTable2").PivotFields("Portfolio")

pf1.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
pf2.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value

ActiveSheet.RefreshAll
ActiveSheet.Move After:=Workbooks(strDest).Sheets(1)
End If
End If
Next i

Workbooks(strDest).Sheets("Sheet1").Delete
strFileName = Format(shStatic.Range("Import_Date"), "yyyymmdd") & " - " & rangeName

For Each mySheet In Sheets
With mySheet
If .Visible = True Then .Select Replace:=False
End With
Next mySheet

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strFilePath & strFileName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Workbooks(strDest).Close
Next k

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.StatusBar = Format(Timer - Deb, "0.00 s") & " : Terminé"
End With
End Sub