XL 2019 Extraction de Données dans fichier PDF

Sub Imprimer(choix As Boolean)
    Dim r As Range, P As Range, n&, c As Range
    Dim foundCell As Range
    Set r = Range("B3:B" & Rows.Count)
    
    ' Si le tableau est vide, sortir de la macro
    If Application.CountA(r) = 0 Then Exit Sub
    
    ' Si l'utilisateur a fait un choix de sélection
    If choix Then
        ActiveCell.Activate ' Au cas où la sélection est un objet
        Set r = Intersect(Selection, r)
        If r Is Nothing Then Exit Sub ' Si aucune intersection, sortir de la macro
        Set r = IIf(r.Count = 1, r.Resize(2), r) ' S'assurer d'avoir au moins 2 cellules
    End If
    
    Application.ScreenUpdating = False ' Désactiver la mise à jour de l'écran pour accélérer
    
    With Sheets("Imprimante")
        .PageSetup.PrintArea = "" ' Effacer la zone d'impression
        .PageSetup.FitToPagesWide = 1 ' 1 page en largeur
        .PageSetup.FitToPagesTall = 1 ' 1 page en hauteur
        
        ' Parcourir chaque cellule constante dans la plage r
        For Each r In r.SpecialCells(xlCellTypeConstants)
            Set P = r.CurrentRegion ' Récupérer la région actuelle de la cellule
            .Cells(6, 2) = r ' Copier la valeur de r dans la cellule (6, 2)
            
            ' Recherche de la cellule contenant "Observation*" dans la colonne 2
            Set foundCell = .Columns(2).Find("Observation*", , xlValues)
            
            ' Si une cellule contenant "Observation*" est trouvée
            If Not foundCell Is Nothing Then
                .Range(.Rows(8), foundCell).Delete ' Effacer la zone de "Observation*" et en dessous
            Else
                ' Aucun "Observation*" trouvé, continuer sans suppression
                MsgBox "Aucune cellule contenant 'Observation*' trouvée dans la colonne 2", vbExclamation
            End If
            
            ' Insérer des lignes en fonction de la taille de P
            .Rows(8).Resize(5 * P.Rows.Count).Insert
            
            ' Boucler à travers les cellules de la colonne 2 dans P
            n = 0
            For Each c In P.Columns(2).Cells
                .Cells(8 + n, 2).Resize(4) = Application.Transpose(c.Resize(, 4))
                n = n + 5 ' Incrémentation de n pour décaler les lignes
            Next c
            
            ' Imprimer ou afficher un aperçu selon la valeur de choix
            If choix Then
                .PrintPreview ' Afficher un aperçu avant impression
            Else
                .PrintOut ' Imprimer directement
            End If
        Next r
    End With
    
    Application.ScreenUpdating = True ' Réactiver la mise à jour de l'écran
End Sub

Private Sub CommandButton1_Click() 'bouton PDF
Dim F As Worksheet, i&, n&, j&, k%
Set F = Sheets("PDF")
Application.ScreenUpdating = False
With Range("B3:F" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    For i = 1 To .Rows.Count
        If .Cells(i, 1) <> "" Then
            n = 6
            F.Rows(n & ":" & Rows.Count).ClearContents  'RAZ
            F.Cells(n, 2) = .Cells(i, 1)
            n = n + 2
            j = i
            While .Cells(j, 2) <> ""
                For k = 2 To 5
                    F.Cells(n, 2) = .Cells(j, k): n = n + 1
                Next k
                n = n + 1: j = j + 1
            Wend
            F.Cells(n, 2) = "Observations :"
            For k = 1 To 3: F.Cells(n + k, 2) = String(168, "."): Next k
            F.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & .Cells(i, 1) & ".pdf"
            i = j
        End If
    Next i
End With
End Sub

'---insère des lignes de séparation vides---
With Range("B3:F" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    For i = .Rows.Count To 2 Step -1
        If .Cells(i, 1) <> "" And Application.CountA(.Rows(i - 1)) Then .Rows(i).Insert xlDown
    Next i
End With