clm = shm.Cells(2, shm.UsedRange.Columns.Count).End(xlToLeft).column

Private Sub Worksheet_Change(ByVal Target As Range)   
   Dim i As Integer   
   If Target.Column <> 1 Then Exit Sub   
   For i = 1 To Len(Target)   
       If Asc(Mid(Target, i, 1)) > 191 And Asc(Mid(Target, i, 1)) < 256 Then   
           MsgBox "Неправильный ввод", vbExclamation   
           Target = ""   
       Exit Sub   
       End If   
   Next   
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   On Error Resume Next
   Dim i As Integer
   If Target.Column <> 10 Then Exit Sub
   For i = 1 To Len(Target)
   Select Case Asc(Mid(Target, i, 1))
       Case 32, 45, 39, 96, 1040 To 1105
       Case Else: Target = "": MsgBox "Только на кириллице!", vbCritical, "Ограничение ввода букв"
   End Select
   Next
End Sub

If shm.Cells(i, 1).address = Target.Addres

Private Sub Worksheet_Change(ByVal Target As Range)
   'Do nothing if more than one cell is changed or content deleted
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim i As Long

    n = shm.Cells(shm.Rows.Count, 1).End(xlUp).Row
    For i = 4 To n Step 5
        If shm.Cells(i, 1) = Target.Address Then MsgBox Target.Address
    Next i

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Sub CopyNames()
    Application.ScreenUpdating = False
    Dim i, k As Long
    
    For i = 4 To n
        For k = 1 To n
            shm.Cells(k, 2) = shm.Cells(i, 1)
        Next k
        i = i + 4
    Next i
    Application.ScreenUpdating = True
End Sub

Dim i, ra
Dim t

t = TextBox1.Value
ra = sha.Range(sha.Cells(1,1), sha.Cells(Rows.Count, 1).End(xlUp).Row).Value

For i = 1 to UBound(ra)
    if t>=ra(i,1) and t<ra(i+1, 1) then
       msgbox ra.offset(0,1)
    else
       end sub
    end if
next