Hi Ivanov,

This code should do it. I used a collection to compile the list of
unique words as i didn't know how long your list would be. A quicker
method would be to copy one list below the other and use advanced
filter to extract the unique records, but that has a limitation of the
two lists together being no longer than 64K rows in total (in Excel
2003). The collection method negates this.

Sub MergeList()
Dim FrList As Range, DeList As Range, DestList As Range
Dim cell As Range, WordList As New Collection, i As Integer

'This sets the range of the French list
Set FrList = Sheets("Sheet1").Range("A1")
Set FrList = Range(FrList, FrList.Range("A65536").End(xlUp))
FrList.Resize(FrList.Rows.Count, 2).Name = "FrList"

'This sets the range of the German list
Set DeList = Sheets("Sheet2").Range("A1")
Set DeList = Range(DeList, DeList.Range("A65536").End(xlUp))
DeList.Resize(DeList.Rows.Count, 2).Name = "DeList"

'This sets the range of the new destination list
Set DestList = Sheets("Sheet3").Range("A1")

'Turn off screen refresh & calculation to speed up execution
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Error handling for when the program attempts to add
'the same word to the collection twice
On Error Resume Next

'Add English words from French list
For Each cell In FrList.Cells
If Not IsEmpty(cell) Then
WordList.Add cell.Value, CStr(cell.Value)
End If
Next

'Add English words from German list (ignoring duplicates)
For Each cell In DeList.Cells
If Not IsEmpty(cell) Then
WordList.Add cell.Value, CStr(cell.Value)
End If
Next

'Turn error notification back on
On Error GoTo 0

'Resize destination list to fit total words
Set DestList = DestList.Resize(WordList.Count, 1)

'Loop to put words to new list
i = 1
For Each Item In WordList
DestList.Cells(i) = Item
i = i + 1
Next

'Sort new list alphabetically
DestList.Sort DestList, xlAscending

'Add VLookup formulas for French and German
DestList.Offset(0, 1).FormulaR1C1 =
"=IF(ISERROR(VLOOKUP(RC[-1],FrList,2,0)),"""",VLOOKUP(RC[-1],FrList,
2,0))"
DestList.Offset(0, 2).FormulaR1C1 =
"=IF(ISERROR(VLOOKUP(RC[-2],DeList,2,0)),"""",VLOOKUP(RC[-2],DeList,
2,0))"

'Clean up
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

*** Beware of wrapping.

Let me know how you go.

Cheers,
Ivan C.

On Apr 1, 8:21*pm, "
wrote:
Here is a sample of the file to process:http://rapidshare.com/files/10399603...ists.xlsx.html

Thank you for any help suggested