kapalı dosyadan iki farklı kritere göre filtreleme

[tahsinanarat]

aşağıdaki kod ile kapalı olan garantidışıfişler.xlsm çalışma sayfasının musuteri_telefonları sayfasının 5.sutununda bulunan soyadına göre sorgulama yaptırıp aynı olanların listelenmesini yapabiliyorum.
Aynı sayfanın 4.sutununda (d sutunu) bulunan isim kriterini de yazarak adı ve soyadına göre sorgulama yapmak istiyorum, kodda nasıl bir değişiklik yapmalıyız. Yardımcı olabilecek arkadaşlarıma şimdiden teşekkür ederim.

Sub arabul()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim k1, k2 As Workbook
Set k1 = ActiveWorkbook

Dim KK 'As Worksheet
Dim KA As Worksheet
Dim son As Long
On Error Resume Next
Aranan = Range("e1")

Range("A3:N65536").ClearContents
yol = "D:\garanti_dışı\garantidışıfişler.xlsm"
Set k2 = Application.Workbooks.Open(yol)
Set KK = k2.Sheets("musteri_telefonları")
Set KA = k1.Sheets("Musteriara")
son = KK.Range("a" & Rows.Count).End(xlUp).Row

KK.Columns(5).AutoFilter Field:=1, Criteria1:="=*" & Aranan & "*" _
, Operator:=xlAnd
KK.Range("A2:h" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=KA.Range("A3")
k2.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'MsgBox " B i t t i ", vbInformation, "ASKM"
End Sub

 

[Korhan Ayhan]

Merhaba,

Makro kaydet ile belirttiğiniz filtrelemeyi yapıp kaydı durdurun. Daha sonra aşağıdaki satırı oluşan makroya göre modifiye edin.

KK.Columns(5).AutoFilter Field:=1, Criteria1:="=*" & Aranan & "*" , Operator:=xlAnd

 

[Korhan Ayhan]

Merhaba,

Özel mesaj ile çözüm bulamadığınızı belirtmişsiniz.

Örnek dosyalarınızı eklerseniz yardımcı olmaya çalışırız.

 

[askm]

Benim özelden ilettiğim çözüm sonuca ulaştırmış olması gerekli.

 

[tahsinanarat]

Sn. askm beyin kodları ile oldu, kendisine teşekkür ediyorum.

Sub arabul2()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim k1, k2 As Workbook
Set k1 = ActiveWorkbook

Dim KK 'As Worksheet
Dim KA As Worksheet
Dim son As Long
On Error Resume Next
Aranan = Range("d1")
Aranan2 = Range("e1")

Range("A3:N65536").ClearContents
yol = "D:\garanti_dışı\garantidışıfişler.xlsm"
Set k2 = Application.Workbooks.Open(yol)
Set KK = k2.Sheets("musteri_telefonları")
Set KA = k1.Sheets("Musteriara")
son = KK.Range("a" & Rows.Count).End(xlUp).Row

KK.Range("$A$1:$J$" & son).AutoFilter Field:=4, Criteria1:="=*" & Aranan & "*" _
        , Operator:=xlAnd
KK.Range("$A$1:$J$" & son).AutoFilter Field:=5, Criteria1:="=*" & Aranan2 & "*" _
        , Operator:=xlAnd

KK.Range("A2:h" & son).SpecialCells(xlCellTypeVisible).Copy Destination:=KA.Range("A3")
k2.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'MsgBox " B i t t i ", vbInformation, "ASKM"
End Sub