Word 2010 - page break before H2 except after H1

I've got a word document with more or less the following structure:

Title
Heading 1
  Heading 2
    Text
  Heading 2
    Text
Heading 1
  Heading 2
    Text
...

I'd like page breaks before all H2 headings, except the ones directly after H1 headings, when I'd prefer the two headings to be on the same page.

I know I can automatically set "page break before" in the style for Heading 2, but is there some way I can set an "except directly after Heading 1" option without having to add all the page breaks manually?

In other words, I'd like the breaks as follows:

Title
-- Page Break --
Heading 1
  Heading 2
    Text
-- Page Break --
  Heading 2
    Text
-- Page Break --
Heading 1
  Heading 2
    Text
-- Page Break --
  Heading 2
    Text
...

Creating a new style will accomplish what you want. Try this procedure:

1. Use the Paragraphs dialog box to make Word insert a page break before all Heading 2 text.
2. Create a new style, "Heading 2 Prime", that's exactly like Heading 2, but uncheck the "page break before" option. Be sure you spell "Heading 2 Prime" exactly as written here.
3. Press Alt+F11 to open the VBA development environment, then click "Insert > Module" to open a new window for entering programs.
4. Paste the following statements into the window. These statements replace all Heading 2 paragraphs that come after Heading 1 paragraphs, with the Heading 2 Prime style.

Code to paste:

'''''''''''''''''''''''''''''''''''''''''''
Sub replace_Heading2_with_Heading2Prime()

Dim i As Integer
Dim s As String
Dim h As String

'''''''''''''''''''''''''''''''''''''
'loop through all pgp and report heading 2

For i = 1 To ActiveDocument.Paragraphs.Count

s = ActiveDocument.Paragraphs(i).Style

If (s = "Heading 2") Then
 h = findPriorHeading(i - 1)
 If (h = "Heading 1") Then
 ActiveDocument.Paragraphs(i).Style = "Heading 2 Prime"
 End If
End If

Next i

Exit Sub

End Sub

Function findPriorHeading(iPgp As Integer) As Variant
Dim i As Integer
Dim blnFoundHeading As Boolean
'walk backwards until any heading is found
 With ActiveDocument
 i = iPgp
 blnFoundHeading = False
 Do Until (i < 1 Or blnFoundHeading)
 s = .Paragraphs(i).Style
 If (InStr(s, "Heading") > 0) Then
 blnFoundHeading = True
 findPriorHeading = s
 Exit Function
 End If
 i = i - 1
 Loop
 End With
 findPriorHeading = ""

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Press Alt+F11 to return to Word, then press Alt+F8 to open the Macros dialog box. Double click the "replace_Heading2_with_Heading2Prime" item to run the macro.

I hope this helps.