I found the solution by myself!
Sub Replacement() ' Replacement Macro Sub Replacement() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Dim n As Integer n = 1000 Do Until n > 1100 With Selection.Find .Text = ChrW(n) .Replacement.Text = "" .Forward = True .Wrap = wdFindStop End With Selection.Find.Execute Replace:=wdReplaceAll n = n + 1 Loop End Sub