Translating letters from english to russian

Help to finish macro. It has to work in sheet "INFO".

russA1=""
dlina = Len( A1 )
'Сначала обрабатываем самые "длинные" буквы:
i = 1
do while i<= dlina
     r = ""
     s = lcase$(Mid$( A1, i, 2 ))
     Select case True
              case s = "ch": r = "ч"
              case s = "sh": r = "ш"
              case s = "zg": r = "ж"
              ' и так далее
     End Select
     'Проверю, малоли буква большая была:
     s = Mid$( A1, i, 2 ) 
     if ucase$(left$(s,1))=left$(s,1) then r=ucase$(r)
     russA1 = russA1 + r
     i=i+1
loop

i = 1
do while i<= dlina
     r = ""
     s = lcase$(Mid$( A1, i, 1 ))
     Select case True
              case s = "a": r = "а"
              case s = "b": r = "б"
              case s = "c": r = "ц"
              case s = "d": r = "д"
              ' и так далее
     End Select
     'Проверю, малоли буква большая была:
     s = Mid$( A1, i, 1 ) 
     if ucase$(left$(s,1))=left$(s,1) then r=ucase$(r)
     russA1 = russA1 + r
     i=i+1
loop

thanks in advance