split word document

Option Explicit
Sub Split_Pages()
    Dim docExisting As Document, docNew As Document
    Dim RangePage As Range
    Dim intLastPageNum As Long, intLastPage As Long, strNewFile As String
     
    Set docExisting = ActiveDocument
    Set RangePage = docExisting.Range
    intLastPage = docExisting.Content.ComputeStatistics(wdStatisticPages)
    intLastPageNum = 1
    Do Until intLastPageNum > intLastPage
        
        If intLastPageNum = intLastPage Then
            RangePage.End = ActiveDocument.Range.End
        Else:
            Selection.GoTo wdGoToPage, wdGoToAbsolute, intLastPageNum + 4
            RangePage.End = Selection.Start
        End If
        
        RangePage.Copy
        Set docNew = Documents.Add
        docNew.Range.Paste
        docNew.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
        strNewFile = Replace(docExisting.FullName, ".doc", intLastPageNum & "  to " & intLastPageNum + 4 & ".doc")
        docNew.SaveAs strNewFile
        intLastPageNum = intLastPageNum + 4
        docNew.Close
        RangePage.Collapse wdCollapseEnd
    
    Loop


    Set docExisting = Nothing
    Set docNew = Nothing
    Set RangePage = Nothing
End Sub

Option Explicit
Sub test_Only_On_Dummy_Data()
Dim lngPage As Long, objPage As Range
With ActiveDocument
  For lngPage = .ComputeStatistics(wdStatisticPages) To 1 Step -1
    Set objPage = ActiveDocument.GoTo(What:=wdGoToPage, Name:=lngPage)
    Set objPage = objPage.GoTo(What:=wdGoToBookmark, Name:="\page")
    With objPage
        With .Find
                .Execute FindText:="XP01"
                If Not .Found = True Then
                   objPage.Delete
                End If
            End With
    End With
  Next
End With


End Sub