Function Translit(ByVal txt As String) As String
iRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
iTranslit = Array("", "a", "b", "v", "g", "d", "e", "yo", "jh", "z", "i", "y", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "z", "ch", _
"sh", "shz", "`", "i", "'", "e", "yu", "ya")
For iCount% = 1 To 33
txt = Replace(txt, Mid(iRussian$, iCount%, 1), iTranslit(iCount%), , , vbTextCompare)
Next
Translit$ = txt
End Function

Sub ПримерИспользованияФункцииTranslit()
txt = "проверка работы транслита"
newtxt = Translit(txt) ' результат = строка "proverka rabot'y translita"
MsgBox "Строка """ & txt & """" & vbNewLine & "преобразована в строку """ _
& newtxt & """", vbInformation, "Результат обработки"
End Sub