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
Set docMultiple = ActiveDocument
Set rngPage = docMultiple.Range
iCurrentPage = 1
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
rngPage.End = Selection.Start
End If
rngPage.Copy
Set docSingle = Documents.Add
docSingle.Range.Paste
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
FileName = Date
docSingle.SaveAs "C:\Windows\Temp\" & FileName & "." & iCurrentPage & ".rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub

       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
        Set docMultiple = ActiveDocument
        iCurrentPage = 1
        iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
        Do Until iCurrentPage > iPageCount
        Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
   MyRange.ShapeRange.Select
        Selection.Copy
        iTempDir = Environ("Temp")
        Set docSingle = Documents.Add
        docSingle.Range.Paste
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
        strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
        FileName = Date
        docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
        iCurrentPage = iCurrentPage + 1
        docSingle.Close
        Loop
        Application.ScreenUpdating = True
        Set docMultiple = Nothing
        Set docSingle = Nothing
        Set rngPage = Nothing
        End Sub

Sub SplitIntoPages()
Application.ScreenUpdating = False
Set docMultiple = ActiveDocument
iCurrentPage = 1
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
MyRange.ShapeRange.Select
Selection.Copy
iTempDir = Environ("Temp")
Set docSingle = Documents.Add
docSingle.Range.Paste
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
FileName = Date
docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub

Sub SplitIntoPages()
Application.ScreenUpdating = False
iCurrentPage = 1
iPageCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
MyRange.ShapeRange.Select
Selection.Copy
iTempDir = Environ("Temp")
Set docSingle = Documents.Add
docSingle.Range.Paste
FileName = Date
docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
Loop
Application.ScreenUpdating = True
Set docSingle = Nothing
Set rngPage = Nothing
End Sub