tümünü yazdır makrosunun sadeleştirilmesi

[meleklerim]

Arkadaşlar merhaba,
Bir belgemde TÜMÜNÜ YAZDIR komutunu aşağıda yazdığım gibi bir makro ile kullanıyorum. Toplam 40 a kadar gidiyordu ve ben kopyalayarak çoğaltıyordum.
Ancak şimdi 400 kişilik bir kopyalama yapmak gerekti.

Bu durumda bunun kolay yolu yok mu?
----Yani AE6 yı seç ActiveCell.FormulaR1C1 = "1" den başla 400 e kadar devam et diyebilir miyiz?
----Ya da belli bir sayı aralığı verilebilir mi? ae6 yı seç ActiveCell.FormulaR1C1 = "325" yaz, 400e kadar devam et gibi

selamlar kolay gelsin

Range("AE6").Select
ActiveCell.FormulaR1C1 = "1"
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
Range("AE6").Select
ActiveCell.FormulaR1C1 = "2"
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
Range("AE6").Select
ActiveCell.FormulaR1C1 = "3"
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
Range("AE6").Select

 

[Necdet]

Merhaba,

Kodları bir kenara bırakın, ne yapmak istediğinizi anlatın.

AE6 hücresine 1 değerini neden veriyorsunuz ve nerede kullanıyorsunuz.
Sonra bu hücreye 2 veriyorsunuz neden?

vs vs

yapmak istediğinizi anladın. Yardım daha çabuk gelecektir.

 

[meleklerim]

2 sayfalık bir excel belgem. var
sayfa1 de düşeyara formülleri ile şekillenmiş form var.
sayfa 2 de ise forma aktarılan bilgilerin yer aldığı tablo var.

ae6 ya 1 yazdığımda
1. satırdaki veriler forma işleniyor ve yadır deyip 1. elemanın formunu çıkarıyorum.
ae6 ya 2 yazdığımda 2. elemanın formu..... bu böyle devam ediyor.

1 ve 2 yazmayı da yukardaki makro ile sağladığımdan tümünü yazdır dediğimde baştan sona tüm form tabloya göre tek tek yazdırılıyor.

şimdi tabloda 400 kişi olduğu için 400 kere kopyalayıp yapıştırmak istemedim.
o makronun sadeleşmesini istiyorum.

Umarım anlatabildim, saygılar

 

[meleklerim]

http://s4.dosya.tc/server2/yfxybh/ARALIKLI_YAZDIR.xlsx.html

örnek belge ekledim arkadaşlar.
Bilen arkadaşların yardımına acil ihtiyacım var.
yardımcı olacaklara şimdiden teşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.

Sıra numarası ardışık gittiği için kodu kısa yazdım.

Sub Dikdörtgen2_Tıklat()

    Dim i   As Integer, _
        c   As Range, _
        Shi As Worksheet
    
    Set Shi = Sheets("İsim Listesi")
    
    If IsNumeric(Range("Y2")) = True And IsNumeric(Range("Y7")) = True Then
        
        For i = Range("Y2") To Range("Y7")
        
            Range("F22") = Shi.Range("B" & i + 1)
            ActiveSheet.PrintOut
        
        Next i
        
    End If
     
End Sub

 

[meleklerim]

çok teşekkür ederim, işim görüldü
sağolun varolun

 

[meleklerim]

Necdet Bey,
Bu makroda bir değişiklik yapmak gerek oldu.
Artık bir seferde 2 isim yazdırmak istiyoruz. Şimdiki halinde f22 hücresini kullanarak tek tek isim yazdırabiliyoruz. Öbür 2. isim için ise f23 hücresini kullanmamız gerek.

Şöyle ki;
Fakat şimdi diyelim Y2 ye 1; Y7 ye 4 yazdık
1. Öğrenciyi f22
2. Öğrenciyi f23
yazdır
3. Öğrenciyi f22
4. Öğrenciyi f23
yazdır

şeklinde devam etmesini sağlayacak şekilde makroda nasıl bir düzenleme yapmalıyız? Yoksa yeni bir makro mu yazmak gerekecek?

Başka bir deyişle tabloda tek sayılı öğrenciler f22 ye çift sayılı sırada olan öğrenciler f23 hücresine gelmeli

25 öğrenci yazdırılacaksa son aşamada f23 hücresi boş olacak bu durumda

yardımcı olacağınız için şimdiden teşekkürler.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub Dikdörtgen2_Tıklat()
    Dim i   As Integer, _
        c   As Range, _
        Shi As Worksheet
    Set Shi = Sheets("İsim Listesi")   
    If IsNumeric(Range("Y2")) = True And IsNumeric(Range("Y7")) = True Then    
        For i = Range("Y2") To Range("Y7") [COLOR="red"]Step 2
[/COLOR]            Range("F22") = Shi.Range("B" & i + 1)
 [COLOR="Red"]           Range("F23") = Range("F22") +1[/COLOR]
            ActiveSheet.PrintOut
        Next i
    End If
End Sub

 

[meleklerim]

Range("F23") = Range("F22") +1

Bu satırda hata verdi
Hata Kodu: 13
Type mismatch

 

[YUSUF44]

Bir noktayı atlamışım. aşağıdaki gibi deneyin:

Sub Dikdörtgen2_Tıklat()
    Dim i   As Integer, _
        c   As Range, _
        Shi As Worksheet
    Set Shi = Sheets("İsim Listesi")
    If IsNumeric(Range("Y2")) = True And IsNumeric(Range("Y7")) = True Then
        For i = Range("Y2") To Range("Y7") Step 2
            Range("F22") = Shi.Range("B" & i + 1)
            Range("F23") = Shi.Range("B" & i + 2)
            ActiveSheet.PrintOut
        Next i
    End If
End Sub

 

[meleklerim]

teşekkür ederim bu çalışıyor, Ancak tekli sayılarda sorun var.
Şöyle ki; tekli sayıda olsa hep çift sayıda liste çıkarıyor.

örnek olarak
yani 1-3 arasını yazdır dediğimde

3. kişiyi f22 atıp, f23e 4. kişiyi yazıyor.
halbuki f23 ün boş olması gerekiyor bu durumda
bu durum için de bir satır ekleyebilir miyiz?
emekleriniz için tekrar teşekkürler.

 

[YUSUF44]

Şöyle oluyor mu?

Sub Dikdörtgen2_Tıklat()
    Dim i   As Integer, _
        c   As Range, _
        Shi As Worksheet
    Set Shi = Sheets("İsim Listesi")
    If IsNumeric(Range("Y2")) = True And IsNumeric(Range("Y7")) = True Then
        For i = Range("Y2") To Range("Y7") Step 2
            Range("F22") = Shi.Range("B" & i + 1)
            If i + 1 <= [Y7] Then
                Range("F23") = Shi.Range("B" & i + 2)
            End If
            ActiveSheet.PrintOut
        Next i
    End If
End Sub

 

[meleklerim]

Hayır olmadı Yusuf Bey
F23 e hiç veri atmadı bu sefer

 

[YUSUF44]

Bende düzgün çalışıyor. Ancak örnek dosyanızda F22 ile F23 hücrelerini birleştirmişsiniz. Onları çözdünüz mü?

 

[meleklerim]

Çözmüştüm yusuf bey,

hata şu:
1-5 arasını yazdırırken 5 kişi çıkması gerek.
Örnek dosyadaki isimlerden gidersek
yazdırma sayfaları şöyle çıkıyor
1-Kevser..
2-Seda....
(sorun yok)

3-Serkan...
4-Mehmet Aşık
(sorun yok)

5-Fatma....
6-Mehmet Aşık (şimdi buranın "F23" boş olması gerekir halbuki)

 

[Korhan Ayhan]

Alternatif;

Sub YAZDIR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Integer
    
    Set S1 = Sheets("İsim Listesi")
    Set S2 = Sheets("Sayfa1")
    S2.Range("F22:F23").ClearContents
    
    For X = S2.Range("Y2") To S2.Range("Y7")
        S2.Range("F22") = S1.Cells(X + 1, "B")
        If X + 2 <= S2.Range("Y7") Then
            S2.Range("F23") = S1.Cells(X + 2, "B")
        End If
        S2.PrintOut
        S2.Range("F22:F23").ClearContents
        X = X + 1
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[meleklerim]

geç cevap yazdığım için kusura bakmayın ama diğer tekli versiyonu kullanıyorduk.
buna yeni işimiz düştü. teklileri gayet güzel çıkarıyor fakat çiftlide son öğrenciyi siliyor.

S2.Range("F22:F23").ClearContents
bu işlemi çift sayılı belgelerde yapmaması gerekiyor.