Sub Demo()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
  If Par.Style = "Normal" Then
    If Rng Is Nothing Then
      Set Rng = Par.Range
    Else
      Rng.End = Par.Range.End
    End If
  Else
    Call RngFmt(Rng)
  End If
  If Par.Range.End = ActiveDocument.Range.End Then
    Call RngFmt(Rng)
  End If
Next
Application.ScreenUpdating = True
End Sub

Sub RngFmt(Rng As Range)
If Not Rng Is Nothing Then
  With Rng
    If .Characters.Last.Information(wdWithInTable) = True Then
      .Characters.Last.Next.InsertBefore "/>" & vbCr
      .Characters.Last.Next.Style = "Normal"
    Else
      .End = .End - 1
      .InsertAfter vbCr & "/>"
    End If
    If .Characters.First.Information(wdWithInTable) = True Then
      .Characters.First.Previous.InsertBefore vbCr & "</"
      .Characters.First.Previous.Style = "Normal"
    Else
      .InsertBefore "</"
    End If
  End With
  Set Rng = Nothing
End If
End Sub