Sayfaya bilgi yedekleme

[sattar]

Eklediğim dosyadaki şablonu fatura çıkarmada kullanıyorum. Makbuz başlıklı sayfa 1 deki 7,9,12 . Satırdaki hücrelere girdiği bilgiler 27,29,31 . Satırlara kopyalanıyor ve makbuz yazdırıyorum bu makbuz çift olarak çıkıyor ve 1 i bende bir diğeri müşteride kalıyor sizden ricam 7 satır ı sütunundaki hücre yani kurum hücresine örneğin tedaş, gaski yada telekom yazıp yazdırdığımda o başlıkla açtığım sayfalara listelemesi mesela tedaş faturası yazdırıp ctrl+p deyip yazdırdığımda sayfa 2 ye kaydetmesi gaski yazıp ctrl+p dediğimde sayfa 3 e kaydetmesi ve her yeni sayfa yazdırdığımda hangi kurumsa yedeğini kendi sayfasına alt alta listeleyip yedek tutmam ...bunun için yardımcı olacak arkadaşlar varsa bi bakarlarsa çok sevinirim işim için çok yardımcı olacak

 

[sattar]

yardımcı olacak anlayan arkadaş yokmu hiç?

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kurum adlarının bulunduğu hücreye VERİ DOĞRULAMA uygulanmıştır. Yeni kurum adı olursa bu menüden eklemeniz gerekir. Forumda bu konuyla ilgili bilgiler bulunmaktadır.

Kullanılan kodlar;

Boş bir modüle uygulayın.

Option Explicit
 
Sub YAZDIR_YEDEKLE()
    Dim SAYFA As String, SATIR As Long, YAZDIR As Boolean
 
    Sheets("MAKBUZ").Select
 
    If Range("I7") <> "" Then
        SAYFA = Range("I7")
    Else
        MsgBox "Lütfen firma adı giriniz !", vbCritical
        Range("I7").Select
        Exit Sub
    End If
 
    YAZDIR = Application.Dialogs(xlDialogPrint).Show
 
    If YAZDIR = False Then
        MsgBox "İşleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
 
    If SAYFA = "TÜRKSAT" Or SAYFA = "SMİLE" Or SAYFA = "DİGİTÜRK" Or _
    SAYFA = "VODAFONE" Or SAYFA = "AVEA" Or SAYFA = "TÜRKCELL" Then GoTo Devam
 
    With Sheets(SAYFA)
        SATIR = .Range("A65536").End(3).Row + 1
        .Cells(SATIR, "A") = Range("F7")
        .Cells(SATIR, "B") = Range("I7")
        .Cells(SATIR, "C") = Range("F9")
        .Cells(SATIR, "D") = Range("O12")
        .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
    End With
 
Devam:
 
    With Sheets("TÜMÜ")
        SATIR = .Range("A65536").End(3).Row + 1
        .Cells(SATIR, "A") = Range("F7")
        .Cells(SATIR, "B") = Range("I7")
        .Cells(SATIR, "C") = Range("F9")
        .Cells(SATIR, "D") = Range("O12")
        .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
    End With
End Sub

 

[sattar]

TŞK

Korhan abiye yardımlarındn ve çalışmalarından dolayı çok teşekkür ediyorum uzun zamandır yaptıramadığım dosyayla ilgilenip yaptığı için allah raı olsun

 

[sattar]

Bu arada vedat özer kardeşimede teşekkürler ilgilendiği için

 

[sattar]

Korhan abi dediğin gibi excell 2007 yükledim şuanda kodlarda değişiklik yapıcam demiştiniz,ben adsl ve kredi kartı ekledim sayfa olarak onlarda yedeklenenler içine alınırsa abi sana zahmet
birde butonu kaldırmak daha mantıklı geldi çünki elimiz ctrl+p tuşuna alıştı yazdırmada
eğer ı 11 hücresine saat eklenebilirse tamam olucak şimdiden tşk kolay gelsin

 

[sattar]

Bazı sayfaların sütun isimlerini değiştim ama kontrol ederseniz daha sağlıklı olur heralde

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodları deneyin.

ThisWorkbook bölümüne aşağıdaki kodu uygulayın. Dosyanızı kaydedin ve kapatıp açın. CTRL+P tuşlarına bastığınızda makro çalışacaktır.

Option Explicit
 
Private Sub Workbook_Activate()
    Application.OnKey "^p", "YAZDIR_YEDEKLE"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^p", ""
End Sub
Private Sub Workbook_Deactivate()
    Application.OnKey "^p", ""
End Sub

Boş bir modüle aşağıdaki kodu uygulayın.

Option Explicit
 
Sub YAZDIR_YEDEKLE()
    Dim SAYFA As String, SATIR As Long, YAZDIR As Boolean
 
    Sheets("MAKBUZ").Select
 
    If Range("I7") <> "" Then
        SAYFA = Range("I7")
    Else
        MsgBox "Lütfen firma adı giriniz !", vbCritical
        Range("I7").Select
        Exit Sub
    End If
 
    YAZDIR = Application.Dialogs(xlDialogPrint).Show
 
    If YAZDIR = False Then
        MsgBox "İşleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
 
    If SAYFA = "TÜRKSAT" Or SAYFA = "SMİLE" Or SAYFA = "DİGİTÜRK" Or _
    SAYFA = "VODAFONE" Or SAYFA = "AVEA" Or SAYFA = "TÜRKCELL" Then GoTo Devam
 
    If SAYFA = "TEDAŞ" Then
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I9")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
 
    ElseIf SAYFA = "KREDİ KARTI" Then
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I9")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
 
    Else
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I7")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
    End If
 
Devam:
    With Sheets("TÜMÜ")
         SATIR = .Range("A65536").End(3).Row + 1
        .Cells(SATIR, "A") = Range("F7")
        .Cells(SATIR, "B") = Range("I7")
        .Cells(SATIR, "C") = Range("F9")
        .Cells(SATIR, "D") = Range("O12") - 1
        .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
        .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
        .Cells(SATIR, "G") = Range("I9")
    End With
End Sub

 

[sattar]

Tam istediğim gibi oldu korhan abi teşekkürler

 

[sattar]

Abi en çok lazım olanı unutmuşum umarım en kolay işlemdir sizin için sıkıntı vermeye başladım artık kusura bakma. Yolladığım ekte bir kaç değişiklik yaptım ben abi onun üzerinden makbuz sayfasındaki tutarların yazdığı o12 hücresindeki bilgiler diğer sayfalara kopyalanacağı zaman 1 tl düşük yedeklenme imkanı varmı acaba

 

[Korhan Ayhan]

Selamlar,

#8 nolu mesajımdaki kodu ve dosyayı güncelledim. İncelermisiniz.