Sub Demo()
Dim oRng As Range
Dim oRngDup As Range
  Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .Style = ActiveDocument.Styles("Heading 2")
      Do While .Execute
        Set oRngDup = oRng.Duplicate
        oRngDup.Collapse wdCollapseStart
        oRngDup.MoveEndUntil ".", wdForward
        oRngDup.End = oRngDup.End + 1
        oRngDup.Style = ActiveDocument.Styles("Strong")
        oRng.Collapse wdCollapseEnd
        If oRng.End + 1 = ActiveDocument.Range.End Then Exit Do
      Loop
   End With
End Sub