Function Translit(Txt As String) As String
Dim Eng As Variant
Eng = Array("q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", _
"]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", _
"x", "c", "v", "b", "n", "m", ",", ".", "Q", "W", "E", "R", "T", _
"Y", "U", "I", "O", "P", "[", "]", "A", "S", "D", "F", "G", "H", _
"J", "K", "L", ";", "'", "Z", "X", "C", "V", "B", "N", "M", ",", "."

Dim Rus As Variant
Rus = Array("й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", _
"ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "э", "я", "ч", "с", _
"м", "и", "т", "ь", "б", "ю", "Й", "Ц", "У", "К", "Е", "Н", "Г", _
"Ш", "Щ", "З", "Х", "Ъ", "Ф", "Ы", "В", "А", "П", "Р", "О", _
"Л", "Д", "Ж", "Э", "Я", "Ч", "С", "М", "И", "Т", "Ь", "Б", "Ю"

For I = 1 To Len(Txt)
с = Mid(Txt, I, 1)

flag = 0
For J = 0 To 64
If Eng(J) = с Then
outchr = Rus(J)
flag = 1
Exit For
End If
Next J
If flag Then outstr = outstr & outchr Else outstr = outstr & с
Next I

Translit = outstr
End Function