Sub Translate()
Dim cell1, cell2 As Range
Dim i, Langs As Long

Langs = 2  'êîëè÷åñòâî ÿçûêîâ ïåðåâîäà (âêëþ÷àÿ ðóññêèé)

    For Each cell1 In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
        For Each cell2 In Worksheets("Ñëîâàðü").Cells.SpecialCells(xlCellTypeConstants)
            If cell1.Value = cell2.Value Then
                i = cell2.Column
                If i = Langs Then i = 1 Else i = i + 1
                cell1.Value = Worksheets("Ñëîâàðü").Cells(cell2.Row, i).Value
                GoTo 1
            End If
        Next cell2
1:   Next cell1
End Sub


Sub ScanText()
    i = 0
    For Each sht In ActiveWorkbook.Sheets
    If sht.Name = "Ñëîâàðü" Then GoTo 2
    For Each cell In sht.Cells.SpecialCells(xlCellTypeConstants)
        c = Asc(cell.Value)
        If (c >= 65 And c <= 122) Or (c >= 192 And c <= 255) Then
            cell.Copy Destination:=Worksheets("Ñëîâàðü").Range("A1").Offset(i, 0)
            i = i + 1
        End If
    Next cell
2:  Next sht
End Sub