Option Explicit 'This goes in the Declarations section of your code module.
 'Hopefully it is already there because you have ticked the 'Require Variable Declaration' _
checkbox. (Tools/Options, Editor tab.) 
 
 
Sub SplitIntoPages() 
    Dim docMultiple As Document 
    Dim docSingle As Document 
    Dim rngPage As Range 
    Dim iCurrentPage As Integer 
    Dim iPageCount As Integer 
    Dim strNewFileName As String 
     
    Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
    flicker a bit. 
    Set docMultiple = ActiveDocument 'Work on the active document _
    (the one currently containing the Selection) 
    Set rngPage = docMultiple.Range 'instantiate the range object
    iCurrentPage = 1 
     'get the document's page count
    iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) 
    Do Until iCurrentPage > iPageCount 
        If iCurrentPage = iPageCount Then 
            rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
        Else 
             'Find the beginning of the next page
             'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 
             'Set the end of the range to the point between the pages
            rngPage.End = Selection.Start 
        End If 
        rngPage.Copy 'copy the page into the Windows clipboard
        Set docSingle = Documents.Add 'create a new document
        docSingle.Range.Paste 'paste the clipboard contents to the new document
         'remove any manual page break to prevent a second blank
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 
         'build a new sequentially-numbered file name based on the original multi-paged file name and path
        strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") 
        docSingle.SaveAs strNewFileName 'save the new single-paged document
        iCurrentPage = iCurrentPage + 1 'move to the next page
        docSingle.Close 'close the new document
        rngPage.Collapse wdCollapseEnd 'go to the next page
    Loop 'go to the top of the do loop
    Application.ScreenUpdating = True 'restore the screen updating
     
     'Destroy the objects.
    Set docMultiple = Nothing 
    Set docSingle = Nothing 
    Set rngPage = Nothing 
End Sub