Разделение документа Word по 2 страницы

[WindBlow]

Приветствую!
Подскажите, нашел рабочий код разделения документа постранично, но нужно чтобы разделялось по две страницы. Т.е. есть, например, документ из 100 страниц, нужно создать несколько двухстраничных со страницами 1-2, 3-4, ... , 99-100
Что нужно изменить в следующем коде?
Sub Split()
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, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
docSingle.SaveAs strNewFileName
iCurrentPage = iCurrentPage + 1
docSingle.Close
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End SubПробовал менять значения рядом с iCurrentPage, но он то три страницы цеплял, то одну... К сожалению не сильно разбираюсь в VBA, извините...

[Iska]

Не называйте собственные процедуры именами встроенных функций

Попробуйте так (не проверялось):
Option Explicit

Sub SplitBy2Pages()
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 + 2
rngPage.End = Selection.Start
End If

rngPage.Copy

With Documents.Add
.Range.Paste
'.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
.SaveAs strNewFileName
iCurrentPage = iCurrentPage + 2
.Close
End With

rngPage.Collapse wdCollapseEnd
Loop

Application.ScreenUpdating = True

Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub