Split document into multiple single-paged documents

Ease of Use


Version tested with

2003 (not 97) 

Submitted by:

Graham Skan


This macro split a document into a several documents, each one corresponding to a page in the original document. 


You might have a document with similar information on each page that you now want to distribute separately. The macro will split on automatic or manual page breaks. If the latter, the manual page break is removed in the new document to prevent an extra blank page appearing. 


instructions for use


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

How to use:

  1. If you unfamiliar with creating Word macros from code, here is a step-by-step method that uses the menus.
  2. Go to Tools/Macro/Macros...
  3. Type the macro name in the top text box. Make sure that the name does not appear in the list below unless you want to replace the already existing macro. At this stage it can be virtually any other single word. The VBA editor will open and display a new Sub procedure, empty of all but a couple of comment lines.
  4. Copy the code above and paste it over the new procedure, so that the latter is replaced.
  5. Do File/Close and return to Microsoft Word.

Test the code:

  1. Open your document that needs to be split - or show its window if it is already open, but you were working on another document.
  2. From the menu do Tools/Macro/Macros... , select the macro by name in the list and click Run.

Sample File:

SplitExample.zip 10.23KB 

Approved by mdmackillop

This entry has been viewed 223 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express