Судя по коду, ненайденное (одно) как раз обрабатываются:  
 
If Not sRow Is Nothing Then  
...  
Else:  
myRange.HighlightColorIndex = wdRed  
Exit Sub  
End If  
 
Вероятно, зацикливается что-то другое...  
По F8 тщательно отслеживали?

Мне кажется, что если убрать Exit Sub, то зацикливания быть не должно.  
Хотя без файлов или спеца по ворду сказать сложно...

Так попробуйте:  
 
 
Sub Find2()  
   Dim oFile, wsSh As Worksheet, Openbook, Book  
   Set wsh = CreateObject("WScript.Shell")  
   docs = wsh.SpecialFolders("Desktop")    'получение адреса рабочего стола  
   CurrentPath = ThisWorkbook.Path    ' получение адреса текущей папки  
   Form = "Юр _форм _автозамена.doc"  
   Set obook = Workbooks.Open(docs & "\" & "crm_ui_frame(1)")    ' имя книги по умолчанию  
   Dim oWord As Word.Application  
   Dim oDoc As Word.Document  
   Set oWord = CreateObject("Word.Application")  
   Set oDoc = oWord.Documents.Add(CurrentPath & "\" & Form)    'запускаем форму  
   oWord.Visible = True  
   oWord.Tasks("Microsoft Word").Activate  
   'oWord.Application.ScreenUpdating = False  
   ' thisdocument.Activate  
   Set myRange = oDoc.Content  
   myRange.Find.ClearFormatting  
   With myRange.Find  
       .Text = "[[]?*[]]"
       .Forward = True  
       .Wrap = wdFindContinue  
       .Format = False  
       .MatchWildcards = True  
       .Execute  
       Do While .Found = True    ' проблемный участок  
           MsgBox myRange  
           .Execute  
           Codes = Mid(myRange, 2, Len(myRange) - 2)  
           Set sRow = Cells.Find(What:=Codes, After:=ActiveCell, LookIn:=xlFormulas, LookAt _  
                                                                                     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _  
                                 False, SearchFormat:=False)  
           If Not sRow Is Nothing Then  
               sRow = sRow.Row  
               Values = obook.Sheets(1).Range("B" & sRow).Value  
               oDoc.Content.Find.ClearFormatting  
               With oDoc.Content.Find  
                   .Text = myRange  
                   .Replacement.Text = Values  
                   .Forward = True  
                   .Format = False  
                   .Execute Replace:=wdReplaceAll, Forward:=True  
               End With  
           Else:  
               myRange.HighlightColorIndex = wdRed  
               oDoc.Content.Find.ClearFormatting  
               With oDoc.Content.Find  
                   .Text = myRange  
                   .Replacement.Text = "not found!"  
                   .Forward = True  
                   .Format = False  
                   .Execute Replace:=wdReplaceAll, Forward:=True  
               End With  
 
               'Exit Sub  
           End If  
       Loop  
   End With  
End Sub

Не нашёл, как в Ворде тормознуть поиск по кругу, поэтому просто заменяю все объекты поиска  - на найденное или на "not found!" :)