düşey ara formülünü sayfa1 ve sayfa2 göre uyarlama

[oydemir]

bulduğum düşeyara formülünü kendi sayfama uyarlamak istiyorum
çalışan düşe yara formülünü (sayfa düşe yarada çalışıyor) ben sayfa1 de değerleri bulup sayfa ikiye yazmasını istiyorum.

bu makro çalışıyor
Sub DictionaryVLookup()

Dim x, x2, y, y2()
Dim dict As Object
Dim ws As Worksheet

Set ws = ActiveSheet
Set dict = CreateObject("Scripting.Dictionary")

With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row
x = .Range("A2:A" & lr).Value
x2 = .Range("B2:B" & lr).Value
For i = 1 To UBound(x, 1)
dict.Item(x(i, 1)) = x2(i, 1)
Next i
lr2 = .Cells(Rows.Count, "D").End(xlUp).Row
y = .Range("D2" & lr2).Value
ReDim y2(1 To UBound(y, 1), 1 To 1)
For i = 1 To UBound(y, 1)
If dict.exists(y(i, 1)) Then
y2(i, 1) = dict(y(i, 1))
Else
y2(i, 1) = "Bulunamadi"
End If
Next i
.Range("G2:G" & lr2).Value = y2
.Range("G2:G" & lr2).Select
End With

Set dict = Nothing

End Sub

 

[oydemir]

teşekkürler sorun çözüldü

 

[oydemir]

arkadaşlar sorun devam ediyor Düşeyara sayfasını sildiğim zaman sayfa iki deki değerlere bulunamadı dedi