Sub DPU_Test()
Application.ScreenUpdating = False
Dim Para As Paragraph
Dim oRng As Range
Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = ".^p"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    End With
On Error Resume Next
For Each Para In ActiveDocument.Paragraphs
With Para.Range
If Len(.Text) > 2 Then
If Not .Characters.Last.Previous Like "[.!?:;]" Then
.Characters.Last.InsertBefore ";"
End If
End If
End With
Next
Application.ScreenUpdating = True

End Sub