Может возникнуть ситуация, что нужно разделить многостраничный документ на отдельные документы. Например, каждая страница несет отдельную информацию, а таких десятки или сотни.

Примечание. Если вам необходимо разделить информацию в документе, которая занимает 1,5, 2 или большее количество страниц, то способ не поможет. Предложенный макрос разделяет лишь по 1 странице.

Алгоритм работы:

1. Скопировать многостраничный документ, который нужно разделить в отдельную папку. Открыть его. Дальше: «Вид → Макросы → Макросы».

2. Если у вас до сих пор не было макросов и в открывшемся окне они не отображаются, то нужно нажать «Создать». Если макросы уже присутствуют, то нужно выделить любой из них и нажать «Изменить» или нажать сочетание клавиш Alt + F11. Запустится окно программы Microsoft Visual Basic.

3. Скопировать следующий код макроса:
Sub РозбитиДокументНаСторінки()
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

4. Найти где заканчивается последний макрос (если поле пустое, то просто вставить скопированный код нашего макроса) и вставить скопированный код. После этого можно закрыть окно Microsoft Visual Basic.

Статья по теме: «Макрос для замены малой буквы первого слова на большую (изменение регистра)»

5. Далее перейти в «Вид → Макросы → Макросы» и найти только что добавленный (имя: РозбитиДокументНаСторінки), выделить его и нажать на кнопку «Выполнить».

6. После выполнения команд ваш документ будет разделен постранично (каждая страница на отдельном документе). Все документы будут добавлены в папку основного документа и будут иметь его название + номер страницы (смотрите снимок экрана ниже).

Макрос можно переименовать. Название макроса находится в начале и выделено полужирным: Sub РозбитиДокументНаСторінки(). Найдите его в коде, который показан выше и переименуйте если нужно. Имя не должно содержать пробелов.

Макрос взят с сайта http://wordexpert.ru.