Sayfalar Arası Kritere Uygun Bul ve Sil,

[Utekiner]

Merhaba;

Liste sayfasındaki Q sütununda "OK" yazıyorsa ise, D sütunundaki malzeme no yu Kalan Liste sayfasının A sütununda aramasını, bulması durumda Kalan Liste sayfasındaki tüm satırı silmesi için makro kod paylaşabilir misiniz...

Örnek Dosya

 

[Ziynettin]

Merhaba.

Kodu deneyiniz...

Sub test()
Set s1 = Sheets("Liste")
Set s2 = Sheets("Kalan Liste")
Set dc = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, 17).End(3).Row
a = s1.Range("D2:Q" & son).Value
krt = "OK"
For i = 1 To UBound(a)
    If a(i, UBound(a, 2)) = krt Then
        dc(CStr(a(i, 1))) = CStr(a(i, 1))
    End If
Next i

If dc.Count > 0 Then
son = s2.Cells(Rows.Count, 1).End(3).Row
a = s2.Range("A2:M" & son).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
For i = 1 To UBound(a)
    krt = CStr(a(i, 1))
    If Not dc.exists(krt) Then
        say = say + 1
        For j = 1 To UBound(a, 2)
            b(say, j) = a(i, j)
        Next j
    End If
Next i
If say > 0 Then
    s2.Range("A2:M" & Rows.Count) = ""
    s2.[A2].Resize(say, UBound(a, 2)) = b
End If
End If
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[Utekiner]

Eline sağlık teşekkür ederim. @Ziynettin