Поиск текста с выводом адреса ячейки

Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Поиск" Then
       Set FR = Ws.Cells.Find(f)
       If Not FR Is Nothing Then adr = adr & " " & Ws.Name & "!" & FR.Address
    End If
    Next
Cells(i, 5) = adr
adr = ""
Next
End Sub

Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms()
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Поиск" Then
       Set FR = Ws.Cells.Find(f)
       If Not FR Is Nothing Then
          adr = adr & " " & Ws.Name & "!" & FR.Address
          '---цикл по следующим найденным ячейкам
          a = FR.Address '---запоминаем адрес первой найденной ячейки
          Do
            Set FR = Ws.Cells.FindNext(FR)
            If FR.Address = a Then Exit Do
            adr = adr & " " & Ws.Name & "!" & FR.Address
          Loop
          '-----------
        End If
    End If
    Next
'Cells(i, 5) = adr 'если в одну
'если один адрес - одна ячейка
ms = Split(Mid(adr, 2, 1000))
Cells(i, 5).Resize(, UBound(ms) + 1) = ms
'-------------------------
adr = ""
Next
End Sub

Dim ms

If adr <> "" Then
  ms = Split(Mid(adr, 2, 1000))
  Cells(i, 5).Resize(, UBound(ms) + 1) = ms
End If