Sub Find_ContSectionBrks()

Dim Rng As range
    Application.ScreenUpdating = False
    Set Rng = Selection.range
    With Rng.Find
        .ClearFormatting
       .Replacement.ClearFormatting
       .text = "^12"
       .Forward = True
       .Wrap = wdFindStop
       .MatchWildcards = True
       While .Execute
          If Rng.Characters.Last.Information(wdActiveEndPageNumber) = _
            Rng.Characters.Last.Next.Information(wdActiveEndPageNumber) Then
             Rng.Select
             Rng.InsertBefore "ContBr" 
             Selection.range.HighlightColorIndex = wdBrightGreen
             Rng.Collapse wdCollapseEnd
          End If
       Wend
    End With
    Application.ScreenUpdating = True
    Set Rng = Nothing
End Sub