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
    .End = .End - 1
    .InsertBefore "</"
    .InsertAfter vbCr & "/>"
  End With
  Set Rng = Nothing
End If
End Sub