Code:
Sub Limpa_texto()
Dim lngIndex As Long, oRng As Range
Dim strLS As String
Dim arrFind, arrReplace
strLS = Application.International(wdListSeparator)
arrFind = Array("^32{1,}^13", "^13^32{1,}", "^13{2,}", "^32{2,}")
arrReplace = Array("^p", "^p", "^p", " ")
Set oRng = ActiveDocument.Range
Application.ScreenUpdating = False
For lngIndex = 0 To UBound(arrFind)
With oRng.Find
.Text = Replace(arrFind(lngIndex), ",", strLS)
.Replacement.Text = Replace(arrReplace(lngIndex), ",", strLS)
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Next lngIndex
'Deal with dispersed tables and final paragraph.
For lngIndex = ActiveDocument.Range.Paragraphs.Count To 1 Step -1
If Len(ActiveDocument.Range.Paragraphs(lngIndex).Range.Text) = 1 Then
ActiveDocument.Range.Paragraphs(lngIndex).Range.Delete
End If
Next
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub