Sub DocumentSplitter()
Dim iCount As Long, iLast As Long, wdDocSrc As Document, wdDocTgt As Document
Dim RngSplit As Range, StrDocName As String, StrDocExt As String, DocFmt As Long, Rslt
Set wdDocSrc = ActiveDocument
With wdDocSrc
  Rslt = InputBox("The document contains " & .ComputeStatistics(wdStatisticPages) & " pages." _
    & vbCr & "What is the page block count for splitting?", "Document Splitter")
    If Rslt = "" Then Exit Sub
    Rslt = CLng(Rslt)
  StrDocName = .FullName
  StrDocExt = "." & Split(StrDocName, ".")(UBound(Split(StrDocName, ".")))
  StrDocName = Left(StrDocName, Len(StrDocName) - Len(StrDocExt)) & "_"
  DocFmt = .SaveFormat
  On Error Resume Next
  For iCount = 0 To Int(.ComputeStatistics(wdStatisticPages) / Rslt)
    If .ComputeStatistics(wdStatisticPages) > Rslt Then
      iLast = Rslt
    Else
      iLast = .ComputeStatistics(wdStatisticPages)
    End If
    Set RngSplit = .GoTo(What:=wdGoToPage, Name:=iLast)
    Set RngSplit = RngSplit.GoTo(What:=wdGoToBookmark, Name:="\page")
    RngSplit.Start = .Range.Start
    Set wdDocTgt = Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False)
    With wdDocTgt
      .Range.FormattedText = RngSplit.FormattedText
      .SaveAs2 FileName:=StrDocName & iCount + 1 & StrDocExt, FileFormat:=DocFmt, AddToRecentFiles:=False
      .Close
    End With
    RngSplit.Cut
  Next iCount
  Set RngSplit = Nothing
  .Close Savechanges:=False
End With
Set RngSplit = Nothing: Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
End Sub