How about
Code:
Sub DeleteBoldItalics()
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.MatchWildcards = True
.Text = "Title and subtitle at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}"
.Execute
.Text = "Title and subtitle at the date"
.Replacement.Text = "Title and subtitle"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
With Selection.Find.Replacement.Font
.Bold = True
.Italic = True
End With
With Selection.Find
.Text = "Title and subtitle"
.Replacement.Text = "Title and subtitle"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub