Koşullu Yazdırma

[meleklerim]

İyi günler arkadaşlar
userformda bir commandbutonuna
anasayfada (a2) de bulunan sayıyı aynı çalışma kitabının başka bir sayfasında (A1) hücresine kopyaladıktan sonra yine anasayfada B sütununda adları bulunan sayfaları yazdırmasını, bu işlemi anasayfadaki A sütunundaki son satıra kadar devam etmesini istiyorum.
örnek olarak eklediğim dosyada ayrıntısını verdim.
yardımcı olacaklara şimdiden teşekkür ederim

 

[AdemCan]

Merhaba dener misiniz?

Private Sub CommandButton1_Click()
Dim s1 As Worksheet

For i = 2 To Sayfa1.Cells(Rows.Count, 1).End(3).Row
    If Sayfa1.Cells(i, 1) = "" Then
        MsgBox "A sütununda boş alan var!"
        Exit Sub
    End If

    If Sayfa1.Cells(i, 2) = "" Then
        MsgBox "Sayfa isminde (B sütununda) boş alan var!"
        Exit Sub
    End If

    Sheets("F1").Range("A1") = Sayfa1.Cells(i, 1)
    Set s1 = Sheets(Sayfa1.Cells(i, 2).Text)
    s1.PrintOut
    
Next i
End Sub

 

[meleklerim]

yardımınız için teşekkür ederim ancak
her iki sutundaki satır sayısı aynı olunca tam istediğim yolla olmasa da kendi mantığı içinde sorunsuz çalışıyor.
A daki satır sayısı B den fazla ise B de boş alan var hatası veriyor.
Set s1 = Sheets(Sayfa1.Cells(i, 2).Text)
A ve B biribinden farklı sayıda satır içerebilir. O yüzden yazdırıken B deki satır sayısı kadar yazdırması gerekiyor sanırım.

Bir de asıl önemli olan benim istediğim önce A2 deki sayıyı başka sayfadaki a2 ye kopyaladıktan sonra B deki sayfaların yazılması, SONRA A3 deki sayının başka sayfadaki a2 ye kopyaladıktan sonra B deki sayfaların yazılması
SONRA A4 deki sayının başka sayfadaki a2 ye kopyaladıktan sonra B deki sayfaların yazılması
bu işlem sırasının A sütunudaki son satıra kadar devam etmesi.

Bu makro önce A2 den başlayarak dolu tüm satırları sırayla başka bir sayfanın A2 sine yapıştırdıktan sonra, B2 den başlayarak yazılı olan sayfaları yazdırıyor. Umarım anlatabilmişimdir. Aslında basit ama yazarak anlatmak gerçekten zor.
@AdemCan

 

[AdemCan]

Merhaba, ilk mesajdaki dosyada A sütununda fazla satır olduğu için son satırı A sütununa göre aldırdım.

Ben kodun çalışma şeklini anlatayım, Sizden de isteklerinizi görsel olarak anlatmanızı isteyebilir miyim? Çünkü ilk mesajdaki anlatım ile son mesaj arasında farklılıklar var.

Kod şu şekilde çalışıyor. A2 den döngü başlar, A2 hücresi boş değilse A2 içeriğini F1 sayfası A1 hücresine kopyalar ve B2 de yazılı olan Sayfa ismini çıktı alır. Sonra A3 e geçer ve eğer A3 boş değilse A3 içeriğini F1 A1 e kopyalar, B3 de yazılı olan sayfayı çıktı alır. Bu şekilde sırası ile gider.

 

[meleklerim]

A2 den F1 ekopyaladıktan sonra B sütünundaki yazılı olan TÜM sayfaların çıktısını alsa işimi görecek.
Bu döngü A daki son boş satıra kadar devam etmeli.
yani her copyalama işlemi sonrası B deki tüm sayfaları yazdırmalı
A sütunu ve B sütüundaki satır sayıları farklı olabilir.

 

[AdemCan]

Döngü A2 den başlar ve son dolu satıra kadar devam eder. Boş olan olunca mesaj çıkar ve kod durur.
B sütununda boş alan olunca Mesaj çıkar, mesajdan sonra diğer sayfalar için B sütununun sonuna kadar döngü devam eder.
Çıkan mesajdan sonra kodun durmasını isterseniz Exit Sub satırının başındaki tırnak işaretini silip, GoTo atla ve atla: satırlarını pasif yapınız.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet

For i = 2 To Sayfa1.Cells(Rows.Count, 1).End(3).Row
    If Sayfa1.Cells(i, 1) = "" Then
        MsgBox "A sütununda boş alan var!"
        Exit Sub
    End If

        For b = 2 To Sayfa1.Cells(Rows.Count, 2).End(3).Row
            If Sayfa1.Cells(i, 2) = "" Then
                MsgBox "Sayfa isminde (B sütununda) boş alan var!"
'                Exit Sub
                GoTo atla
            End If
        
            Sheets("F1").Range("A1") = Sayfa1.Cells(i, 1)
            Set s1 = Sheets(Sayfa1.Cells(b, 2).Text)
            s1.PrintOut
atla:
        Next b
    
Next i
End Sub

 

[meleklerim]

çok teşekkür ederim, şimdi istediğim gibi çalışıyor. Elinize sağlık

 

[AdemCan]

Rica ederim.