Microsoft 365 VBA-Fiche de synthèse à partir d'une liste

Sub Truc()
    Const MaxSecondes As Single = 15
    Dim listeCodes As Variant, item As Variant
    Dim tps As Single
   
    With ThisWorkbook
        listeCodes = .Names("Codes3D").RefersToRange.Value
        For Each item In listeCodes
            With .Sheets("Lettre")
                .Select ' Vraiment facultatif
                .Range("C5") = item
                '
                ' Prévoir pendant la phase de tests et
                ' suivant le fichier et la machine un temps d'attente du recalcul
                ' ici limité à 15 secondes maximum mais sans minimum
                ' cela peut être quasi instantané
                tps = Timer
                Do
                    DoEvents
                Loop While Application.CalculationState <> xlDone And Timer < tps + MaxSecondes
                '
                ' une fois l'application calculée, lancer ci-dessous
                ' les actions d'enregistrement pdf
                .ExportAsFixedFormat _
                            Type:=xlTypePDF, _
                            Filename:=ThisWorkbook.Path & "\Fichier_" & item & ".pdf", _
                            Quality:=xlQualityStandard, _
                            includeDocProperties:=True, _
                            IgnorePrintAreas:=False, _
                            OpenAfterPublish:=False
               
            End With
        Next
    End With

End Sub

Sub PDF()
Dim ncol%, tablo, ub&, Code As Range, Stage As Range, R As Range, rc&, cc%, i&, resu(), j&, col%, k%, lig&
With Sheets("liste").[A1].CurrentRegion
    .Sort .Cells(1), xlAscending, Header:=xlYes
    ncol = .Columns.Count
    If ncol < 2 Then ncol = 2
    tablo = .Resize(.Rows.Count + 1, ncol) 'matrice, plus rapide, 1 ligne de plus
    ub = UBound(tablo) - 1
End With
With Sheets("Lettre")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set Code = .[B6] 'à adapter
    Set Stage = .[B10:B38] 'à adapter
    Set R = .[E10:AC38] 'à adapter
    rc = R.Rows.Count: cc = R.Columns.Count
    Application.ScreenUpdating = False
    For i = 2 To ub
        Code = tablo(i, 1) 'Code 3D
        ReDim resu(1 To rc, 1 To cc) 'RAZ
        col = -1
        For j = i To ub
            col = col + 2
            resu(1, col) = tablo(j, 2) 'Codes 5D
            For k = 3 To ncol
                lig = Application.Match(tablo(1, k), Stage, 0)
                resu(lig, col) = tablo(j, k)
            Next k
            If tablo(j + 1, 1) <> tablo(j, 1) Then
                R = resu 'restitution
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & tablo(i, 1) & " - Suivi formations.pdf"
                i = j
                Exit For
            End If
    Next j, i
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B6]) Is Nothing Then Exit Sub
MacroChange = True 'variable déclarée Public dans Module1
PDF 'lance la macro
MacroChange = False
End Sub