Veri Süzmek

[kayra75]

Merhaba Arkadaslar,

Linkte örneğini hazırladığım bir ver Veri süzme konusunda desteğinize ihtiyacım var.

Aranacak sheet de yer alan ürünleri ve karsısındaki tedarikciye göre DATA alanında arama yapıp bu satırı rapor alanına yazmam gerekiyor.

Ekteki örneğe göre yazmam gerekirse ARMUT eğer B tedarikcisinden alındıysa Bu satırı yazın.


Bunu nasıl yaparım.

[link=http://www.dosyayukleyin.com/do.php?id=4898]ORNEKxlsx.xlsx[/link]

 

[Orion1]

Dosyanız linktedir.

DOSYAYI İNDİR

Sub suz59()
Dim sonsat1 As Long, sonsat2 As Long, i As Long
Dim s1 As Worksheet, s3 As Worksheet, sonsat3 As Long
Sheets("ARANACAK").Select
Set s1 = Sheets("DATA")
Set s3 = Sheets("RAPOR")
sonsat3 = s3.Cells(Rows.Count, "A").End(xlUp).Row
If sonsat3 > 1 Then s3.Range("A2:O" & sonsat3).ClearContents
s1.Range("A1").AutoFilter
sonsat1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = Cells(Rows.Count, "A").End(xlUp).Row
s1.Range("A1").AutoFilter
For i = 2 To sonsat2
    sonsat3 = s3.Cells(Rows.Count, "A").End(xlUp).Row + 1
    s1.Range("A1").AutoFilter field:=1, Criteria1:=Cells(i, "A").Value
    s1.Range("A1").AutoFilter field:=14, Criteria1:=Cells(i, "B").Value
    s1.Range("A1:O" & sonsat1).CurrentRegion.Offset(1, 0).Copy s3.Range("A" & sonsat3)
    s1.Range("A1").AutoFilter
Next i
s3.Select
Set s1 = Nothing: Set s3 = Nothing
MsgBox "Veriler süzüldü", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[kayra75]

Elinize sağlık cok tesekkür ederim.