Makroda koşullu renklendirme

[evren_01]

Arkadaşlar

aşağıda makro da yardım
sayfa 1 de B sütünundaki isimlerin karşısında bulunan d sütünundaki görevleri
veri sayfasındaki b sütünundaki isimlerin karşındaki kutulara değeri yazıyor

benim istediğim sayfa1 de d sütünunda yazan yazıların, veri sayfasında renkli hücreler haline geitrmek örneğin muhasebe sarı,satın alma mavi gb

Sub deneme()
Dim tarih As Date
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = ActiveSheet.Range("B65536").End(xlUp).Row '1 ve B65536 olarak değiştirdim.
Set tarihalani = Sheets("icmal").Range("g1:ak1")
Set isimalani = Sheets("icmal").Range("c3:c1053")
tarih = ActiveSheet.Range("f1").Value

For i = 1 To son
isim = ActiveSheet.Range("B" & i).Value

Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
    Sheets("icmal").Cells(satir, sutun) = Sheets("1").Cells(i, 4)
End If
Next i
'Range("A1").Select

End Sub

bu makroyu sayın Hüseyin beye ve Uzaylıya aittir

yardımlarınızı bekliyorum
[/code]