Option Explicit

Sub ChangeKeyboardLayout()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary") ' Лексикон для соответствия символов

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim inputText As String
    Dim result As String
    Dim i As Long
    Dim ch As String

    Dim russianLower As String
    Dim englishLower As String
    Dim russianUpper As String
    Dim englishUpper As String

    Dim keyChar As String
    Dim valueChar As String

    ' Карта перевода: что набираем на русском клавиатуре -> что будет на английской раскладке
    russianLower = "ёйцукенгшщзхъфывапролджэячсмитьбю."
    englishLower = "`qwertyuiop[]asdfghjkl;'zxcvbnm,./"
    
    russianUpper = "Ё""№;:?ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭ/ЯЧСМИТЬБЮ,"
    englishUpper = "~@#$^&QWERTYUIOP{}ASDFGHJKL:""|ZXCVBNM<>?"

     ' Построение словаря соответствий
    Dim idx As Long
    For idx = 1 To Len(russianLower)
        keyChar = Mid$(russianLower, idx, 1)
        valueChar = Mid$(englishLower, idx, 1)
        If Not dict.Exists(keyChar) Then dict.Add keyChar, valueChar
    Next idx

    For idx = 1 To Len(russianUpper)
        keyChar = Mid$(russianUpper, idx, 1)
        valueChar = Mid$(englishUpper, idx, 1)
        If Not dict.Exists(keyChar) Then dict.Add keyChar, valueChar
    Next idx

    ' Обработка диапазона A1:A последняя заполненная строка на первом листе
    Set ws = ThisWorkbook.Sheets(1)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For Each cell In ws.Range("A1:A" & lastRow)
        If Not IsEmpty(cell) Then
            inputText = CStr(cell.Value2)
            result = ""

            If inputText <> "" Then
                For i = 1 To Len(inputText)
                    ch = Mid$(inputText, i, 1)
                    If dict.Exists(ch) Then
                        result = result & dict(ch)
                    Else
                        result = result & ch
                    End If
                Next i
            End If

            cell.Value = result
        End If
    Next cell
End Sub