К заметке "Поиск заголовков и вставка разрывов страниц перед ними" некоторые пользователи оставили абсолютно справедливые комментарии, что при выборе определенного стиля, например, "Заголовок 1", можно в его настройках определить вставку разрыва страницы перед текстом, оформленным данным стилем. И нечего "огород городить" с помощью макроса.

Полностью согласен.

Но мне поступил новый вопрос на почти аналогичную тему от пользователя Валерия. Он спрашивал:

Я снова подумал о макросе и у меня получился следующий вариант (если кто-то знает способ проще, прошу сообщить в комментариях).

Поскольку в настройках нет возможности установить начало стиля заголовка именно с нечетной страницы - только с новой страницы - то я и решил использовать макрос.

Если в документе есть разделы, то могут появиться пустые разделы (без текста). В этом случае я рекомендую удалить все разделы, применить макрос и потом вручную добавить нужные разделы (ну, не совершенный макрос, что поделаешь...).

Sub insBreakOddPage()
'Поиск стиля "Заголовок 1" и перенос заголовков на нечетные страницы
'Если в документе есть разрывы (разделы), то они предварительно удаляются (закомментировано)
Dim i As Long
Dim n As Long
Dim ST As Style
Dim oSec As Section
Dim myRange As Range
'For Each oSec In ActiveDocument.Sections
'  Set myRange = oSec.Range
'  myRange.Collapse wdCollapseEnd
'  myRange.MoveEnd Unit:=wdCharacter, Count:=-1
'  myRange.Delete
'Next
Set ST = ActiveDocument.Styles("Заголовок 1")
Selection.HomeKey Unit:=wdStory  'переходим в начало документа
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindContinue
   .Text = ""
   .Style = ST
   'Запускаем цикл поиска
   Do While .Execute
      If Selection.Style = ST Then
         i = i + 1
         If i = 1 Then
            Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext
         Else
            Selection.Collapse wdCollapseStart
            n = n + 1   'считаем найденные заголовки
            Selection.InsertBreak Type:=wdSectionBreakOddPage
            Selection.Move wdParagraph, 1
         End If
      Else
         Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext
      End If
   Loop
End With
MsgBox "Закончено." & vbCr & "Выполнено для " & n & " заголовков"
End Sub

]]> ]]>