Sub Reformat()
Application.ScreenUpdating = False
Dim i As Long, RngFnd As Range
With ActiveDocument
  Set RngFnd = .Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[^13]{1,}D[ao][s ]{1,2}Vereador*^13"
      .Replacement.Text = ""
      .Execute
    End With
    RngFnd.Start = .Start + 1
  End With
  With RngFnd
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[^13]{1,}"
      .Replacement.Text = "^p^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[ ]{1,}^13"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(D[ao][s ]{1,2}Vereador*)([^13]{1,})"
      .Replacement.Text = "^p\1^l"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(Nº)"
      .Replacement.Text = "^p^l\1"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(MATÉRIA DO LEGISLATIVO)[^13]{1,}"
      .Replacement.Text = "^p^l\1^l^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(INDICAÇÕES)[^13]{1,}"
      .Replacement.Text = "^p^l\1^l^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(MOÇÕES)[^13]{1,}"
      .Replacement.Text = "^p^l\1^l^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{2,}"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = "^l"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      .Text = "[^13]{1,}(D[ao][s ]{1,2}Vereador*)([^13]{1,})"
      .Replacement.Text = "^p^p\1^p"
      .Execute Replace:=wdReplaceAll
    End With
  End With
End With
Application.ScreenUpdating = True
End Sub