Sub Macro1()
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "(^13){2,}"
        .Replacement.Text = "\1"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop
    End With
    Set oRng = Nothing
End Sub