Исправь:  
If .exists(Sheets(1).Cells(i, 5).Value)

Я чуть поэкономней:  
Public Sub www()  
   Dim a, i&  
   a = Sheets(2).Range("a2").CurrentRegion.Value  
   With CreateObject("scripting.dictionary")  
       For i = 1 To UBound(a)  
           If Not .exists(a(i, 1)) Then .Item(a(i, 1)) = a(i, 1)  
       Next  
       a = Sheets(1).Range("e1", [e1].End(xlDown))
       For i = 1 To UBound(a)  
           If .exists(a(i, 1)) Then Sheets(1).Cells(i, 5).Font.Bold = True  
       Next  
   End With  
End Sub

{quote}{login=KukLP}{date=24.03.2012 05:52}{thema=}{post}Прикольно Богдан, ты значению в массиве пытаешься присвоить жирность шрифта:-){/post}{/quote}  
Не смейся :) Меня Саша (Nerv), когда-то пытался научить работать с массивами, но я уже всё забыл (т.к. на работе их не использую), помню только "азы".  
С виду вроде бы всё понятно, а вот если придется написать ещё раз - наверное не напишу...  
Спасибо, сейчас буду разбираться. ;)

Привет, Богдан. Для сравнения/сопоставления по списку используют коллекцию (с обработкой ошибок) или словарь.  
 
 http://msdn.microsoft.com/ru-ru/library/yb7y698k%28v=vs.90%29.aspx  
http://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.85%29.aspx  
http://msdn.microsoft.com/en-us/library/aa164502%28v=office.10%29.aspx

Ребят, подскажите, пожалуйста, ещё разок.  
Как с помощью массивов выделить на Листе2 те данные, которых нет на Листе1?  
Опять таки - циклом слишком долго.  
В примере выделил цветом.  
 
Желательно подкорректировать код:  
   Dim a, i&, lr&  
   a = Sheets(2).Range("a2:a" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row)  
   With CreateObject("scripting.dictionary")  
       For i = 1 To UBound(a)  
           If Not .exists(a(i, 1)) Then .Item(a(i, 1)) = a(i, 1)  
       Next  
       For i = 1 To Sheets(1).[e1].End(xlDown).Row
           If .exists(Sheets(1).Cells(i, 5).Value) Then Sheets(1).Cells(i, 5).Font.Bold = True  
       Next  
   End With

Спасибо, а у меня чет не выходило

Можно изначально загнать содержимое этого друго листа в массив. И в ходе сравнения менять содержимое этого массива. Потом все оптом (весь полученный массив) выгрузить на лист.  
 
Пример коад выгрузки массива:  
With Sheets("ToAdm.")  
.Range("K1").Resize(UBound(main, 1), UBound(main, 2)) = main  
End With

Спасибо, Саш. Но это не совсем то, что надо.  
Посмотри, пожалуйста, на результат цикла и на свой.  
у тебя суммирует, а мне нужно просто первое значение  
-50050-

Немного другой код (см файл), интересно узнать какой быстрее на больших объемах ?  
Если не трудно, сравните.  
 
-= 62226 =- БИНГО !

{quote}{login=LightZ}{date=28.03.2012 08:43}{thema=}{post}мне нужно просто первое значение  
-50050-{/post}{/quote}  
Так и не понял, какое отношение это имеет к полученному результату в твоем случае и случае Антона.  
 
Чтобы мой код заработал также, замени  
Dictionary.Item(key) = Dictionary.Item(key) + arr(i, 3)  
на  
If Dictionary.Exists(key) Then Dictionary.Remove (key)  
Dictionary.Add key, arr(i, 3)

Ещё вопрос - какой максимальный объём обрабатываемых данных с помощью словаря?  
при расчете на более 5к строк - выдает ошибку, но после добавления on error resume next - вроде всё считает правильно, где подвох? :)

Sub GoYa()  
On Error Resume Next  
Application.ScreenUpdating = False  
   Dim lLastrow1 As Long  
   Dim lLastrow2 As Long  
   Dim Dictionary As Object, arr(), key As String, j As Long, i As Long  
   Dim MyArr()  
   Dim li As Long  
     
   Sheets(2).Cells.ClearContents  
   MyArr = Array("Данные", "google", "yandex", "Данные", "google", "yandex")  
   Sheets(2).[a1:f1] = MyArr
     
 
   Sheets(1).Range("A2:A" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy  
   Sheets(2).[a2].PasteSpecial xlPasteValues
   Sheets(1).Range("E2:E" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy  
   Sheets(2).Range("A" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues  
   Application.CutCopyMode = False  
   Sheets(2).Range("A1:A" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo  
       For li = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1  
           If Sheets(2).Range("A" & li).Value = "" Then: Sheets(2).Range("A" & li).Delete (3)  
       Next  
   Sheets(2).Range("A2:A" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets(2).[d2]
 
   lLastrow1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row  
   lLastrow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row  
 
 
   Set Dictionary = CreateObject("Scripting.Dictionary")  
   arr = Sheets(1).Range("A1:C" & lLastrow1).Value  
 
   For i = 1 To UBound(arr, 1)  
       key = arr(i, 1) & arr(i, 2)  
       If Not Dictionary.Exists(key) Then Dictionary.Add key, arr(i, 3)  
   Next  
 
   With Sheets(2).Range("A1:C" & lLastrow2)  
       arr = .Value  
       For j = 2 To UBound(arr, 1)  
           For i = 2 To UBound(arr, 2)  
               key = arr(j, 1) & arr(1, i)  
               arr(j, i) = Dictionary.Item(key)  
           Next  
       Next  
       .Value = arr  
   End With  
 
   Set Dictionary = CreateObject("Scripting.Dictionary")  
   arr = Sheets(1).Range("E1:G" & lLastrow1).Value  
 
   For i = 1 To UBound(arr, 1)  
       key = arr(i, 1) & arr(i, 2)  
       If Not Dictionary.Exists(key) Then Dictionary.Add key, arr(i, 3)  
   Next  
 
   With Sheets(2).Range("D1:F" & lLastrow2)  
       arr = .Value  
       For j = 2 To UBound(arr, 1)  
           For i = 2 To UBound(arr, 2)  
               key = arr(j, 1) & arr(1, i)  
               arr(j, i) = Dictionary.Item(key)  
           Next  
       Next  
       .Value = arr  
   End With  
Sheets(2).Select  
[a1].Select
Application.ScreenUpdating = True  
End Sub