Wordの丸数字1から50までを検索してハイライトするマクロ

先日、Wordの丸数字１から35までを検索してハイライトするマクロを作ったのだけれど、今日、40まで検索してハイライトする必要性ができたので、36から50の部分を新たに追加。
スマートじゃなくて、ゴリゴリやるマクロなので、美しい書き方があったら、教えてください。

＝＝＝＝＝ここからマクロ＝＝＝＝

'
'丸数字をハイライトするためのマクロ
'
'
'ユニコードの入れ物の定義
Dim Word1 As Long

'
'スピードを上げるため画面更新を停止
Application.ScreenUpdating = False

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

'丸数字（�@〜�S）を検索して黄色ハイライト
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[�@-�S]"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchByte = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With

'丸数字の21から35を検索して黄色ハイライト
'最初に検索する丸数字21のユニコード
Word1 = &H3251&

'丸数字35まで繰り返すループ
Do While Word1 < &H3261&

Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(Word1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With
'次に検索すべき丸数字のユニコード
Word1 = Word1 + 1
Loop


'丸数字の36から50を検索して黄色ハイライト
'最初の丸数字36のユニコード
Word1 = &H32B1&
'50までループ
Do While Word1 < &H32C0&

Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(Word1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With
'次に検索すべき丸数字のユニコード
Word1 = Word1 + 1
Loop

'画面の更新を再開
Application.ScreenUpdating = True

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

＝＝＝＝＝ここまでマクロ＝＝＝＝

Wordで丸数字（1から35まで）を検索してハイライトするマクロ

翻訳でナンバリング原稿を送られ、丸数字でナンバリングして訳すことが多々ある。
で、そのナンバリング（丸数字、�@とか�Aとか）をハイライトするマクロを作った。
ちなみに丸数字は１から35まで。36から50までは下記のPDFでUnicodeを拾って、21から35までと同様の方法でできるはず。ただ、こんな風にループにせずに、�@から�Sまでと同じく範囲を指定して検索できる方法があれば、知りたいもんだ。
http://www.unicode.org/charts/PDF/U3200.pdf

＝＝＝＝＝＝＝ここからマクロ＝＝＝＝＝
'1〜35までの丸数字をハイライトするマクロ
'
'ユニコードの入れ物の定義
Dim Word1 As Long

'スピードを速くするため画面更新を停止
Application.ScreenUpdating = False

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

'丸数字（�@〜�S）を検索して黄色ハイライト
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[�@-�S]"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchByte = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With

'丸数字の21から35を検索して黄色ハイライト

'検索する丸数字の最初のユニコード
Word1 = &H3251&

'ユニコードが一定の値になるまでループ
Do While Word1 < &H3261&

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(Word1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With

'次の検索すべきユニコードに変える
Word1 = Word1 + 1

Loop

'画面更新を再開
Application.ScreenUpdating = True

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

＝＝＝＝＝ここまで＝＝＝＝