0'dan Büyük Olanları süz

[iceman20]

Arkadaşlar ekteki dosyada master sayfasının sağına eklediğim butona bastığımda x sütununda (talep koli) 0'dan büyük değerleri süzüp sipariş listesi sayfasına x sütununda çıkan değerlere ilişkili diğer sütunları (tabloda görebilirsiniz) kopyalamak, printerdan sipariş listesi sayfasına gelen ürünleri çıkarmak, sonra sipariş sayfası listesini temizleyip, master tabolsuna dönmek istiyorum. Malumunuz x sütunu değişken hergün ayrı satırlarda 0'dan büyük değer oluyor. (bu kısmı çok önemli) Hatayı nerede yaptığım hakkında yardımlarınız.

 

[acolkesen1]

Merhaba buzadam
Anladığım kadarıyla bir şeyler yapmaya çalıştım.. Dosyanız ektedir, iyi çalışmalar..

 

[acolkesen1]

Sanırım yoğunluktan, dosya bir türlü eklenmiyor
tekrar denerim biraz sonra ..

 

[acolkesen1]

Bir daha deneyelim bakalım..

 

[mancubus]

dener misiniz?

....


hatalı olmuş. pardon...

 

[mancubus]

hatalı mesajımın doğrusu:
(asıl dosyanızı yedekleyerek örnek dosyanızda denemeniz için uyarlanmış bir alternatif.)

Sub Düğme1_Tıklat()

Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
Dim sat As Long, sut As Long
Dim wks1 As Worksheet, wks2 As Worksheet

Set wks1 = Worksheets("MASTER")
Set wks2 = Worksheets("SİPARİŞ LİSTESİ")

wks1.Activate
sat = Cells(Rows.Count, 1).End(xlUp).Row
sut = Cells(1, Columns.Count).End(xlToLeft).Column


If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
ActiveSheet.Range(Cells(1, 1), Cells(sat, sut)).AutoFilter Field:=24, Criteria1:=">0", _
        Operator:=xlAnd

Set r1 = wks1.Columns("D")
Set r1 = r1.Resize(65535, 1).Offset(1, 0)
Set r1 = r1.Resize(, 2).SpecialCells(xlCellTypeVisible)
r1.Copy wks2.Range("D2")

Set r2 = wks1.Columns("K")
Set r2 = r2.Resize(65535, 1).Offset(1, 0)
Set r2 = r2.Resize(, 1).SpecialCells(xlCellTypeVisible)
r2.Copy wks2.Range("A2")

Set r3 = wks1.Columns("X")
Set r3 = r3.Resize(65535, 1).Offset(1, 0)
Set r3 = r3.Resize(, 1).SpecialCells(xlCellTypeVisible)
r3.Copy wks2.Range("F2")

Set r4 = wks1.Columns("AA")
Set r4 = r4.Resize(65535, 1).Offset(1, 0)
Set r4 = r4.Resize(, 1).SpecialCells(xlCellTypeVisible)
r4.Copy wks2.Range("G2")

Set r5 = wks1.Columns("AB")
Set r5 = r5.Resize(65535, 1).Offset(1, 0)
Set r5 = r5.Resize(, 2).SpecialCells(xlCellTypeVisible)
r5.Copy wks2.Range("B2")

wks2.PrintOut

End Sub

 

[iceman20]

ilginiz için çok teşekkür ederim