Yazdir makrosuna kayit yaptirmak

[denfab76]

merhaba,

sayfa1 de iken bir buton yardimiyla asagidaki kod ile sayfa2 deki bilgileri yazdiriyorum. bu islemi yaptiktan sonra sayfa1 deki A1,B1,C1,D1 hücrelerini sayfa3 de kayit altina almasi bu koda bir ekleme yapilarak mümkün mü acaba. sayfa1 de bu islemi yapan diger sayfalar icin baska butonlarimda var. her yazdirma isleminden sonra sayfa3 de alt alta kayit islemi devam etmesi gerekiyor. su an malesef bir dosya ekleyemiyorum.tesekkürler.

Sub etiket2()
Dim sm As Worksheet

Set sm = Sheets("Sayfa2")

ilk = InputBox("Baslangiç seri numarasini giriniz")
Son = InputBox("Bitis seri numarasini giriniz")


yazdir = MsgBox(Son - ilk + 1 & " adet etiket bastirilacaktir: emin misin?", vbYesNo, "Print")
If yazdir = vbYes Then
For i = ilk To Son
sm.Range("f13") = i
sm.PrintOut Copies:=1
Next
End

 

[Ömer]

Merhaba,

Next satırında sonra ilave ederek deneyiniz.

   Dim S1 As Worksheet, S3 As Worksheet, sonsat As Long

    Set S1 = Sheets("Sayfa1")
    Set S3 = Sheets("Sayfa3")
    
    sonsat = S3.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    S1.Range("A1:D1").Copy S3.Cells(sonsat, "A")

 

[denfab76]

Ömer Bey cok tesekkür ederim.

 

[Ömer]

Rica ederim, iyi çalışmalar.

 

[denfab76]

Ömer Bey örnegin üc cikti almama ragmen bir kere yedekleme yapiyor. Her cikti aldikdiktan sonra hücredeki aktuel degerleri ayri ayri cikti sayisi kadar yedeklemek mümkünmüdür. Yani 1. ciktitan sonra hücredeki aktuel degerler, 2. ciktitan sonra hücredeki aktuel degerler.... gibi pes pese yedeklemek mümkün müdür. Üretimdeki her paleti pes pese kayit altina almak istiyorum. Tesekkürler.

 

[Ömer]

Verdiğim kodların ilk 3 satırını Son tanımından sonraya, 4 ve 5. satırları ise next satırından önce ilave ederek deneyiniz.

Şu an Telefondan yazdığım için ben ekleyemedim. Derleyemezseniz ben birazdan düzenlerim.

 

[denfab76]

Söylemis oldugunuz sekilde yaptigimda, asagidaki gibi kod calismadi. Kod lardaki bilgimi maruz görün lütfen.

Sub etiket2()
Dim sm As Worksheet

Set sm = Sheets("Sayfa2")

ilk = InputBox("Baslangiç seri numarasini giriniz")
Son = InputBox("Bitis seri numarasini giriniz")


yazdir = MsgBox(Son - ilk + 1 & " adet etiket bastirilacaktir: emin misin?", vbYesNo, "Print")
If yazdir = vbYes Then
For i = ilk To Son
Dim S1 As Worksheet, S3 As Worksheet, sonsat As Long

Set S1 = Sheets("Sayfa1")
Set S3 = Sheets("Sayfa3")
sm.Range("f13") = i
sm.PrintOut Copies:=1
sonsat = S3.Cells(Rows.Count, "A").End(xlUp).Row + 1

S1.Range("A11").Copy S3.Cells(sonsat, "A")
Next
End

 

[Ömer]

Deneyiniz.

Sub etiket2()

    Dim sm As Worksheet, ilk, son, yazdir As String, i As Integer
    Dim S1 As Worksheet, S3 As Worksheet, sonsat As Long
   
    Set sm = Sheets("Sayfa2")
    Set S1 = Sheets("Sayfa1")
    Set S3 = Sheets("Sayfa3")
    sonsat = S3.Cells(Rows.Count, "A").End(xlUp).Row + 1
   
    ilk = InputBox("Baslangiç seri numarasini giriniz")
    son = InputBox("Bitis seri numarasini giriniz")

    yazdir = MsgBox(son - ilk + 1 & " adet etiket bastirilacaktir: emin misin?", vbYesNo, "Print")
    If yazdir = vbYes Then
        For i = ilk To son
            sm.Range("f13") = i
            sm.PrintOut Copies:=1
            S1.Range("A1:D1").Copy S3.Cells(sonsat, "A")
            sonsat = sonsat + 1
        Next
    End If   

End Sub

 

[denfab76]

Ömer Bey bir kez daha cok tesekkür ederim. Bana cok yardimci oldunuz.