Soru Çıktı Harmanlama Sorunu

[leonadies]

Üstadlar Merhaba;

Aşağıdaki kod ile etiket çıktısı almaktayım.
H6 hücresi toplam etiket sayısını
F6 hücresi Etiketin o anki numarasını göstermekte. Ve makro ile çıktıya gönderirken her çıktıdan sonra F6 sayısı +1 artarak toplam sayısına ulaşıncaya kadar (H6) etiket basmakta.
Yani etiket çıkış görüntüleri
1/4
2/4
3/4
4/4
toplam adete varıncaya kadar baskıya devam ediyor.

Gelelim soruna. Çıktıya gönderirken öncelikle bu baskıdan kaç takım istiyorsunuz diye sorduruyorum. Ve örneğin bu 4 etiketten 2 takım bastıracaksam çıktılarımın;
1/4
2/4
3/4
4/4
1/4
2/4
3/4
4/4

yukarıdaki şekilde olmasını bekliyorum ancak çıktılar;

1/4
1/4
2/4
2/4
3/4
3/4
4/4
4/4

bu şekilde geliyor. burada çözüm Collate:=True ya da False kısmından olması gerekirken ne yaparsam yapayım düzelmiyor. Yani harmanlama çıktı işinde sorunum var.
Çıktıların istediğim sırada çıkması gerçekten önemli. Bu çıkışların aşağıdaki gibi olması için ne yapmayalım? Gerekli dosyaları ekledim

1/4
2/4
3/4
4/4
1/4
2/4
3/4
4/4

Sub yazdir()

    Adet = Application.InputBox("Kaç Takım İçin Yazdırmak İstiyorsunuz?", "Çıktı Adeti", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " Takım için yazdırılacak. Onaylıyor musunuz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then

    Veri1 = Cells(6, 6).Value '------------etiket başlangıç sayısı
    veri2 = Cells(6, 8).Value '-------------etiket bitiş sayısı

    For X = Veri1 To veri2
    [F6] = Veri1
   
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$6" '-------yazdırma alanı
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Collate:=True, Copies:=Val(Adet), ActivePrinter:= _
    "Argox iX4-240 PPLB"
   
    Veri1 = Veri1 + 1
       
        Next
    [F6] = 1
   
   
       Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10      MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If
End Sub

 

[leonadies]

Hala çözüm bulamadım. Yardımcı olur musunuz?

 

[usubaykan]

Sub yazdir()
    Adet = Application.InputBox("Kaç Takım İçin Yazdırmak İstiyorsunuz?", "Çıktı Adeti", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " Takım için yazdırılacak. Onaylıyor musunuz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
    Veri1 = Cells(6, 6).Value '------------etiket başlangıç sayısı
    Veri2 = Cells(6, 8).Value '-------------etiket bitiş sayısı
    
    For X = Veri1 To Adet
            For u = Veri1 To Veri2
                ActiveSheet.PageSetup.PrintArea = "$A$1:$H$6" '-------yazdırma alanı
                 ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Collate:=True, Copies:=Val(1), ActivePrinter:= _
                "Argox iX4-240 PPLB"
               [F6] = u + 1
            Next
    [F6] = 1
        Next
       Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10      MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If
End Sub

kodu bu şekilde deneyiniz.

 

[Korhan Ayhan]

Harmanlama yapabilmeniz için tüm etiketleri ilk önce sayfaya işleyip en sonunda yazdırmanız gerekir.

Ya da @usubaykan'ın yaptığı gibi ikili döngü kullanmanız gerekir.

 

[leonadies]

Çok teşekkürler @usubaykan ve @Korhan Ayhan üstadlarım harika oldu. Ellerinize sağlık