Koşula Bağlı Yazdır Makrosu Çözemedim

[satmus]

Başka sitelerde de aradım .Bir kaç makro denedim ama olmadı. Yardım ederseniz sevinirim.

Data1,data2,data3,data4,data5 adında çalışma sayfalarım var.
Giriş sayfamın;
"P" sütununda hangi çalışma sayfalarının yazdırılacağı,
"Q" sütununda o çalışma sayfasından kaç adet yazdırılacağı,
"R" sütununda çalışma sayfasının yazdırma yönü belirlenmiş.

"YAZDIR" butonuna bastığımda bu koşullara uygun tüm sayfalar otomatik olarak yazdırılsın istiyorum.
Örnek dosyam ektedir.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
On Error Resume Next

For i = 2 To [Q65536].End(3).Row

If Cells(i, "Q") > 0 Then
    syf = Cells(i, "P")
    
        If Cells(i, "R") = "dikey" Then
        Sheets(syf).PageSetup.Orientation = xlPortrait
        Else
        Sheets(syf).PageSetup.Orientation = xlLandscape
        End If
    
    kopya = Cells(i, "Q").Value
    Sheets(syf).PrintOut Copies:=kopya

End If

Next i

End Sub

. . .

 

[satmus]

. . .

Sub KOD()
On Error Resume Next

For i = 2 To [Q65536].End(3).Row

If Cells(i, "Q") > 0 Then
    syf = Cells(i, "P")
    
        If Cells(i, "R") = "dikey" Then
        Sheets(syf).PageSetup.Orientation = xlPortrait
        Else
        Sheets(syf).PageSetup.Orientation = xlLandscape
        End If
    
    kopya = Cells(i, "Q").Value
    Sheets(syf).PrintOut Copies:=kopya

End If

Next i

End Sub

. . .

Öncelikle Hüseyin Bey kodu denedim çalışıyor.Yardımınız için teşekkür ederim.Fakat sanırım ben yanlış yazdım, "Q" sütundaki veriler yazırılacak sayfanın kopya sayısı değil, yazdırma alanındaki sayfa sayısı olacaktı.Onu nasıl düzeltebilirim?

 

[Emir Hüseyin Çoban]

. . .

Böyle bir şey olabilieceğini tahmin etmiştim.
Peki 0 yazdığında hiç yazdırmayacak değil mi ?

Sub KOD()
On Error Resume Next

For i = 2 To [Q65536].End(3).Row

If Cells(i, "Q") > 0 Then
    syf = Cells(i, "P")
    
        If Cells(i, "R") = "dikey" Then
        Sheets(syf).PageSetup.Orientation = xlPortrait
        Else
        Sheets(syf).PageSetup.Orientation = xlLandscape
        End If
    
    [B]bitis [/B]= Cells(i, "Q").Value
    Sheets(syf).PrintOut [B]From:=1, To:=bitis[/B]

End If

Next i

End Sub

. . .

 

[satmus]

Evet. '0' yazdırılmayacaktı. Sorunum çözüldü teşekkürler üstadım

 

[satmus]

Peki üstadım yardımseverliğinizden cesaret bularak son bir şey daha isteyeceğim. Yazıcıdan tek veya çift taraflı çıktı almayı bu makroya ekleyebilir miyiz?

 

[Emir Hüseyin Çoban]

. . .

Benim bildiğim karadıyla, VBA kodları ile çift taraflı çıktı alınamıyor.
Ama başka yöntem veya çözümü bilen arkadaşlar varsa yardımcı olacaklardır.

. . .