Sub FindCirilic()
  Dim rg As Range, s$, re, ms, m
  Set re = CreateObject("VBScript.RegExp")
  re.Global = True: re.ignorecase = True: re.Pattern = "[а-яё]+"
  For Each rg In ActiveSheet.UsedRange
    If Not IsEmpty(rg) Then
      If re.test(rg.Value) Then
        Set ms = re.Execute(rg.Value)
        s = s & ", " & rg.Address(0, 0) & ":"
        For Each m In ms: s = s & m: Next
      End If
    End If
  Next
  If Len(s) Then s = Right(s, Len(s) - 2): MsgBox s
End Sub