Kritere göre ayıkla

[ADER_34]

Merhaba arkadaşlar iyi hafta sonları diliyorum,benim içinden çıkamadığım kod karmaşsı yaşdığım bir durum var onun için vakti olan ustalardan yardım istiyorum,
şöyleki sayfa2 de 2 adet texbox var,sayfa2 "J" sütununa textbox1 de tarih giricem texbox2 de getirmek istediğim kriter giricem ,yani textbox1 de tarih, textbox2 ye de yazdığım kriterin part noları gelsin,istiyorum teşekkürler..
örnek: http://s6.dosya.tc/server3/bn43oa/AKTAR15.rar.html
sayfa1 ART NO :TİP başlığı altındaki verileri süz
sayfa 2 : "J" sütuna tarihe göre ,ve Kritere göre, ayıkla aktar ama sadece PART NO ları aktarmasını istiyorum.

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyin.

 Sub Düğme3_Tıklat()
Dim s1, s2 As Worksheet, n As Integer, bul As String
Set s1 = Sheets(1)
Set s2 = ActiveSheet
Columns("j") = ""
With s1.Range("L1:L" & s1.Cells(Rows.Count, "L").End(3).Row)
    Set c = .Find(CDate(ActiveSheet.TextBox1.Value), LookIn:=xlValues)
    If Not c Is Nothing Then
         bul = c.Address
        Do
        If Trim(s1.Cells(c.Row, "f").Value) = ActiveSheet.TextBox2.Value Then
       n = n + 1
        s2.Cells(n, "J") = s1.Cells(c.Row, "e").Value
           End If
            Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> bul
    End If
End With
End Sub

 

[ÖmerBey]

Merhaba,
Alternatif olsun.

Sub KOD()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("J:J").ClearContents
s1.Range("A:O").AutoFilter Field:=12, Operator:= _
        xlFilterValues, Criteria2:=Array(2, Format(ActiveSheet.TextBox1.Text, "m\/d\/yyyy"))
s1.Range("A:O").AutoFilter Field:=6, Criteria1:=ActiveSheet.TextBox2.Text
s1.Range(s1.Range("E1"), s1.Range("E65500").End(3)).Copy
ActiveSheet.Range("J1").PasteSpecial xlValues
s1.Range("A:O").AutoFilter
End Sub

 

[ADER_34]

Hayırlı geceler sayın plint ve sayın mucit kodlar sorunsuz harika çalışıyor çok teşekkür ederim,iyi çalışmalar..