Sayfa1 deki verileri Sayfa2 de ki sutunlarda arama

[numan şamil]

Merhaba arkadaşlar
Forumda araştırma yaparak aşadaki kodları buldum ancak benim dosyama uyarlayamadım

Sub AKTAR()
For i = 2 To Worksheets("Sayfa1").[a65536].End(3).Row
deg = ""
For j = 2 To Worksheets("Sayfa2").[a65536].End(3).Row
If Sheets("Sayfa1").Cells(i, 1).Value = Sheets("Sayfa2").Cells(j, 1).Value Then

deg = 1

End If
If deg = 1 Then
Sheets("Sayfa1").Cells(i, 2).Value = "Var"
Else
Sheets("Sayfa1").Cells(i, 2).Value = "yok"
End If
Next j
Next i
MsgBox "işlem tamam"
End Sub

Ekli dosyada
sayfa1 "A3:A65536" arasındaki
verileri sayfa2de "A-G-M-S-Y-AE-AK-AQ-AW-BC-BI-BO" sutunlarda arama yaparak Sayfa1 deki verilerin yanındaki ("b" sutununa) ekli dosyada olduğu gibi varsa "var" yoksa yok yazacak
Saygılarımla

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim ALAN As Range, BUL As Range
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    Set ALAN = Application.Union(S2.Range("A:A"), S2.Range("G:G"), S2.Range("M:M"), S2.Range("S:S"), _
    S2.Range("Y:Y"), S2.Range("AE:AE"), S2.Range("AK:AK"), S2.Range("AQ:AQ"), S2.Range("AW:AW"), S2.Range("BC:BC"), S2.Range("BI:BI"), S2.Range("BO:BO"))
 
    For X = 3 To S1.Cells(Rows.Count, 1).End(3).Row
        Set BUL = ALAN.Find(S1.Cells(X, 1), , , xlWhole)
        If Not BUL Is Nothing Then
            S1.Cells(X, 2) = "Var"
        Else
            S1.Cells(X, 2) = "Yok"
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[numan şamil]

Merhaba Korhan Bey
Kodları denedim sorunsuz çalışıyor
Çok teşekkür ederim
iyi çalışmalar