Option Explicit
Sub testx()
Dim dl&, dl2&, dl3&, i&, a&, c As Range, nbpages&, tbsheet(), sh, debut, rg As Range, entete As Range, col1$, col2$, chemin$
Application.DisplayAlerts = False
debut = 5 'ici la ligne du debut à imprimer
With Feuil1
dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row 'Là on est sur!!!!
dl2 = dl + 5 'on collera les tableaux(pages copiées) à partir de cette ligne
dl3 = dl2 'pour garder en memoire la premiere ligne de ce qui sera vraiment imprimé
'-------------------------------------------------------------
Set entete = .[A1:K4] 'determine l'entete
col1 = "A" 'premiere colonne du tableau en lettre
col2 = "K" 'derniere colonne du tableau en lettre
chemin = ThisWorkbook.Path & "\" & "Test.pdf"
'-------------------------------------------------------------
For i = 5 To dl 'redim preserve dans un array des plagesséparées par un saut de ligne
If .Rows(i).PageBreak <> xlNone Then
If i - 1 > debut Then
a = a + 1
ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & i - 1).Address(0, 0)
debut = i
End If
End If
Next
a = a + 1: ReDim Preserve tbsheet(1 To a): tbsheet(a) = .Range(col1 & debut & ":" & col2 & dl).Address(0, 0)
MsgBox "juste pour voir " & vbCrLf & Join(tbsheet, vbCrLf) ' à supprimer
'controle des sauts de page résiduel en dessous du tableau original
nbpages = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
For i = a + 1 To nbpages
On Error Resume Next
ActiveSheet.HPageBreaks(i).Delete
Next
'reconstruction des tableaux avec entete en dessous de l'original
For i = LBound(tbsheet) To UBound(tbsheet)
If i < UBound(tbsheet) Then Set c = Union(entete, .Range(tbsheet(i))) Else Set c = .Range(tbsheet(i))
c.Copy .Range(col1 & dl2)
dl2 = .UsedRange.Cells(.UsedRange.Cells.Count).Row 'Là on est sur!!!!
If i < UBound(tbsheet) Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=.UsedRange.Cells(.UsedRange.Cells.Count)
Next
'si on veut simplement imprimer
'on imprime les pages reconstruite
'.Range(.Range("A" & dl3), .UsedRange.Cells(.UsedRange.Cells.Count)).PrintPreview 'ou printout sur ton imprimante pdf
Set rg = .Range(.Range(col1 & dl3), .UsedRange.Cells(.UsedRange.Cells.Count)) 'ça c'est la plage des tableaux reconstruits
'export pdf
rg.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set rg = Nothing
'et enfin on supprime les pages reconstruites pour revenir à l'original
.Range(.Range(col1 & dl3), Range(col2 & Rows.Count)).EntireRow.Delete Shift:=xlUp
End With
End Sub