makro düzenleme

[burhancavus61]

Aşağıdaki kodumu hiç bozmadan kopya sayısını I4 hücresine göre artırabilirmiyim. Şu haliyle tek sayfa yazıyor

Sub YAZDIR()

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("N1") = 0 Then
    MsgBox "Bu döneme ait bildirge yok."
    ElseIf Range("N1") = 1 Then

    Sheets("Bildirge 1.S.").Visible = 1
    Sheets("Bildirge 2.S.").Visible = 1
    Sheets("Bildirge 3.S.").Visible = 1
    Sheets("AnaSayfa").Select

    Dim Sayfa As Worksheet, Sayfalar(), X As Byte, Say As Long
    Dim Kontrol_1 As Boolean, Kontrol_2 As Boolean, Veri As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Sayfalar = Array("Bildirge 1.S.", "Bildirge 2.S.", "Bildirge 3.S.")
    
    For Each Sayfa In ThisWorkbook.Worksheets
        For X = 0 To UBound(Sayfalar)
            If Sayfa.Name = Sayfalar(X) Then
                Kontrol_1 = True
                Exit For
            End If
        Next
        If Kontrol_1 = True Then
            For Each Veri In Sayfa.Range("A1")
                If Veri.Value > 0 Then
                    Kontrol_2 = True
                    Exit For
                End If
            Next
            If Kontrol_2 = True Then
                Sayfa.PrintOut
                Say = Say + 1
            End If
        End If
        Kontrol_1 = False
        Kontrol_2 = False
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If Say > 0 Then
        MsgBox "Yazdırma işlemi tamamlanmıştır." & Chr(10) & "Yazdırılan sayfa sayısı ; " & Say, vbInformation
    Else
        MsgBox "Yazdırılıcak veri bulunamadı!", vbExclamation
    End If
    Sheets("Bildirge 1.S.").Visible = 0
    Sheets("Bildirge 2.S.").Visible = 0
    Sheets("Bildirge 3.S.").Visible = 0
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End If
End Sub

 

[ÖmerFaruk]

Print satırını değiştirin
Sayfa.PrintOut Copies:=[I4]

 

[burhancavus61]

Teşekkürler