Yazdır butonuna basınca arşivlesin.

[Metin Karaağaç]

İyi akşamlar. Okulda sevk kağıdı verme işini pratikleştirmek için basit bir program hazırladım.
Ancak verdiğimiz sevklerin arşivlenmesi için bir türlü çalışan bir kod yazamadım.
Yapmak istediğim;
"yazdır" butonuna bastığım zaman, Sayfa1'deki "C18-E18-H18-D28-E28" hücrelerindeki bilgileri kopyalayıp, "Sevk Defteri" sayfasına sıra ile numara vererek kaydetsin ve Sayfa1 deki B10 hücresine verdiği numarayı eklesin. En son olarak da yazıcıdan yazdırsın.
Ben birkaç kod denedim ama bir türlü istediğim sonuca ulaşamadım.

 

[Ömer]

Merhaba Metin Bey,

Bu şekilde denermisiniz.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 
    Dim son As Long
    
    If ActiveSheet.Name <> "Sayfa1" Then
        Cancel = True
        Exit Sub
    End If
    
    With Sheets("Sevk Defteri")
        son = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(son, "A") = son - 1
        .Cells(son, "B") = Range("C18")
        .Cells(son, "C") = Range("E18")
        .Cells(son, "D") = Range("H18")
        .Cells(son, "E") = Range("D28")
        .Cells(son, "F") = Range("E28")
    End With
 
    Range("B10") = son - 1
 
End Sub

.

 

[Metin Karaağaç]

Herhangi bir bilgi kaydedilmedi, eklentilerimde bir eksiklik mi var acaba?

 

[Ömer]

Soruyu yanlış anlamadım umarım.

Kodları ThisWorbook bölümüne kopyaladız mı? Bir de kodlar sadece Sayfa1 de iken yazdır butonuna basınca çalışır.

 

[Metin Karaağaç]

Bilgisayarı kapatıp açınca çalıştı.
Teşekkür ederim Ömer Bey.