Dim  sm As String
Dim RG As Range
Dim ReEx As New RegExp
Dim i As Long, j As Long, Max As Long, Max2 As Long, k As Long
Dim Xvar As Variant

    If TypeName(Selection) = "Range" Then
        Set RG = Selection
        Xvar = RG
        With ReEx
            .Global = True
            .IgnoreCase = True
            Max = UBound(Xvar,  1 )
            Max2 = UBound(Xvar,  2 )
            For k =  1  To  33 
                .Pattern = Cells(k,  15 )'русская буква
                sm = Cells(k,  16 )'латиница
                For i =  1  To Max
                    For j =  1  To Max2
                        Xvar(i, j) = .Replace(Xvar(i, j), sm)
                    Next
                Next
            Next
        End With
        RG = Xvar
        
    Else: MsgBox "Выделите ячейки для транслитерации.", vbOKOnly, "Книжная полка"
    End If