Automatically make every other page blank

[Charles Kenyon]

I am trying to assist someone else on the Answers forum. You are welcome to jump in there.
https://answers.microsoft.com/en-us/mso ... 0febaf4756

The solution I am attempting is a Macro but it is erratic in what happens.

Here is the macro.

Code: Select all

Sub AddBlanks()
    ' Charles Kenyon
    Dim IntPages As Long ' original number of pages
    Dim i As Long ' counter
    '
    '   TURN OFF SCREENUPDATING
    Application.ScreenUpdating = False
    '
    '   ERROR HANDLER
    On Error GoTo ErrorHandler
    '
    '   GO TO BEGINNING OF DOCUMENT
    Selection.HomeKey Unit:=wdStory
    '
    '   GET NUMBER OF TIMES TO RUN THIS
    Let IntPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    For i = 1 To IntPages - 1
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
        Selection.InsertBreak Type:=wdPageBreak
    Next i
    '   BLANK HEADERS AND FOOTERS ON EVEN-NUMBERED PAGES
    ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter = True ' sets different even and odd
    '   MAKES SURE THAT EVEN-PAGE HEADERS AND FOOTERS ARE BLANK
    ActiveDocument.StoryRanges(wdEvenPagesFooterStory).Text = ""
    ActiveDocument.StoryRanges(wdEvenPagesHeaderStory).Text = ""
ErrorHandler:
    Application.ScreenUpdating = True
    Application.ScreenRefresh
    On Error GoTo -1
    MsgBox "Document given blank pages between each page."
End Sub

Here is the test document with the macro:

[HansV]

I'd change the loop to

Code: Select all

    For i = IntPages To 2 Step -1
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i
        Selection.MoveLeft
        Selection.InsertBreak Type:=wdPageBreak
    Next i

[Charles Kenyon]

Thank you Hans, works a charm.

[Charles Kenyon]

I passed it on to the OP with credit to you for the help. I also said that I did not think this is a good idea and suggested a pdf instead.