'search for title 1
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Titre 1")
Selection.Find.Execute
'icount < 1000 just in case of infinite loop
Do While Selection.Find.Found = True And icount < 1000

    Title1Array(icount) = Selection.Information(wdActiveEndPageNumber) 'current page
    TitleTxtArray(icount) = Selection.text 'curent title

    Selection.Find.Execute 'search next title1
    icount = icount + 1

Loop

Dim title As String
Dim pagestart As Long
Dim pagesEnd As Long

For i = 1 To icount
    pagestart = Title1Array(i)
    nexti = i + 1
    pagesEnd = Title1Array(nexti) - 1 'page end is (next title1 page) - 1
    title = ActiveDocument.Path & "" & TitleTxtArray(i) & ".pdf"
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        title, ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportFromTo, From:=pagestart, To:=pagesEnd, Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, KeepIRM:=False, CreateBookmarks:= _
        wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
Next i