2 sütuna göre filtrele aktar

[ADER_34]

Merhaba arkadaşlar benim şöyle bir makroya ihtiyacım var,
1. Depo sayfası "R" Sütununda hücrede "KP_RETURN" yazan satırları ve "K" sütunda değeri "0" dan büyük olan satırları süz depo sayfası "A" sütunu ve "K" sütununu-- "Trans" sayfası "A" ve "B" sütunlarına aktar kolay gelsin teşekkürler..
http://www.dosya.tc/server9/zuo6ry/FILTLERE_AKTAR.rar.html

 

[askm]

Aşağıdaki kodları kullanabilirsiniz.

Sub askm_aktar()
Dim s1, s2 As Worksheet
Set s1 = Sheets("DEPO")
Set s2 = Sheets("TRANS")
Dim SonSat As Long
SonSat = s1.Range("A65536").End(xlUp).Row
a = 1
For i = 2 To SonSat
    If s1.Cells(i, "R") = "KP_RETURN" And s1.Cells(i, "K") > 0 Then
        a = a + 1
        s2.Cells(a, 1) = s1.Cells(i, "A")
        s2.Cells(a, 2) = s1.Cells(i, "K")
    End If
Next i
MsgBox "Aktarma işlemi tamamlandı...", vbInformation, "ASKM"
End Sub

 

[ADER_34]

Sayın askm kodlarınız sorunsuz ve hızlı çalışıyor çok teşekkür ederim kolay gelsin..

 

[askm]

Rica ederim.