I making too long Help me

[balavaka]

Is there any other way to achieve the following?

Sub Macro2()
    Selection.Find.ClearFormatting
    Selection.Find.replacement.ClearFormatting
    Selection.Find.replacement.Highlight = True
    With Selection.Find.replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
    End With
    With Selection.Find
        .text = _
            "Received^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^13Revised^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^13"
        .replacement.text = "<PUD>Received \1 \2 \3^lRevised \4 \5 \6^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Call Macro3
End Sub
Sub Macro3()
    Selection.Find.ClearFormatting
    Selection.Find.replacement.ClearFormatting
    Selection.Find.replacement.Highlight = True
    With Selection.Find.replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
    End With
    With Selection.Find
        .text = "^lAccepted^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^13"
        .replacement.text = "^lAccepted \1 \2 \3^lPublished"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub Macro4()
    Selection.Find.ClearFormatting
    Selection.Find.replacement.ClearFormatting
    Selection.Find.replacement.Highlight = True
    With Selection.Find.replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
    End With
    With Selection.Find
        .text = _
            "Received^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^13Accepted^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^13"
        .replacement.text = "<PUD>Received \1 \2 \3^lAccepted \4 \5 \6^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Call Macro5
End Sub
Sub Macro5()
    Selection.Find.ClearFormatting
    Selection.Find.replacement.ClearFormatting
    Selection.Find.replacement.Highlight = True
    With Selection.Find.replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphCenter
    End With
    With Selection.Find
        .text = "^lAccepted^32([0-9]{1,2})^32([A-z]{1,})^32([0-9]{4})^l"
        .replacement.text = "^lAccepted \1 \2 \3^lPublished^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub