Option Explicit
'====================================================================================================
Sub REinRange()
Dim rng As Range, ar As Range
Dim arr, arrOne(1 To 1, 1 To 1)
Dim t!, r&, c&, k&, n&, AC&, flag As Boolean

t = Timer
Set rng = Intersect(Selection, ActiveSheet.UsedRange)

Application.ScreenUpdating = False
AC = Application.Calculation: Application.Calculation = xlCalculationManual

    For Each ar In rng.Areas
        arr = ar.Value
        If Not IsArray(arr) Then arrOne(1, 1) = arr: arr = arrOne

        For c = 1 To UBound(arr, 2)
            For r = 1 To UBound(arr, 1)
                k = FILE_RE_OnlyCyrLCase(arr(r, c))
                If k = 1 Then
                    flag = True
                ElseIf k = 2 Then
                    flag = True: n = n + 1
                End If
            Next r
        Next c

        If flag Then
            flag = False
            ar.Value = arr
        End If
    Next ar

Application.Calculation = AC
Application.ScreenUpdating = True

    If n = 0 Then
        MsgBox "LCase cyrillic NOT FOUND!", vbExclamation, Format(Timer - t, "0.00 sec")
    Else
        MsgBox "Successfully extract values: " & n, vbInformation, Format(Timer - t, "0.00 sec")
    End If
End Sub
'====================================================================================================
'-1 = error; 0 = no changes; 1 = change, but NOT all; 2 = get onle lcase cyrillic
'
Function FILE_RE_OnlyCyrLCase(vl) As Long
Static RE As RegExp, REsp As RegExp, fStatic As Boolean

If IsError(vl) Then FILE_RE_OnlyCyrLCase = -1: Exit Function
If Len(vl) = 0 Then Exit Function

    If Not fStatic Then
        Set RE = New RegExp: RE.Global = True: RE.Pattern = "[^ёа-я ]"
        Set REsp = New RegExp: REsp.Global = True: REsp.Pattern = " {2,}"
    End If

If InStr(vl, " ") Then vl = Replace(vl, " ", " ")   ' replace 160 space to normal (32)

    If RE.Test(vl) Then
        FILE_RE_OnlyCyrLCase = 2
        vl = RE.Replace(Trim(vl), "")
        If InStr(vl, "  ") Then vl = REsp.Replace(vl, " ")  ' replace double spaces
    Else
        vl = Empty
        FILE_RE_OnlyCyrLCase = 1
    End If
End Function