Yazdırırken Farklı Kaydederek Exel olarak masaüstüne alma

[enboy81]

yaptığım projede yazdır butonu çalışıyor fakat ben yazdır butonuna bastığımda yazdırılacak liste nin yazdırmadan önce önizleme yaparak yazdırılacak listeyi farklı kaydet yapıp masaüzerine exel formatında yeniisimle listeyi kayıt etmek istiyorum. Bununla ilgili makro kodu bulamadım yardımcı olabilirmisiniz?

 

[enboy81]

Benim istediğim şekilde bir makro kodu yok sanırım. (listbox ta bulunan verileri farklı kaydet yaparak yeni exel kitabına atmak)

 

[tukayf]

Mutlaka bir çözümü vardır. Örnek dosya olmadığı için çözüm üretecek ustalar deneme yanılma yapmak istemiyor olabilir. Siz örnek dosyanızı ekleyin çözüm muhakkak gelecektir.

 

[enboy81]

Mutlaka bir çözümü vardır. Örnek dosya olmadığı için çözüm üretecek ustalar deneme yanılma yapmak istemiyor olabilir. Siz örnek dosyanızı ekleyin çözüm muhakkak gelecektir.

https://www.dosyaupload.com/b67m Örnek dosyayı ekledim. Listeleme yaptıktan sonra Listeyi Farklı Kaydet butonu ile veya Yazdır Butonuda olabilir Listede bulunan verileri sayfasını yeni kitap exel olarak açmasını istiyoruz, yardımcı olabilirmisiniz?

 

[u.L.a.s]

Merhaba



Kendi Userformunda bulunan yazdır butonuna tekabül eden aşağıdaki kod düzeneğine Yazdır dedikten sonra dosyanın farklı kaydedilmesi kodunu çağırması için Call dosyafarklikaydet eklemesini yap.

Private Sub btnYazdir_Click()
Worksheets("Listele").Printout
Call dosyafarklikaydet
End Sub

Sonrasında
Bir modül oluştur. Bu modül içerisine aşağıdaki kod düzeneğini yapıştır. Bu kod düzeneği Listele Sheetinde bulunan A ve N arası sütunları arasındaki verilerini masaüstüne ayrı bir excel dosyası olarak kaydeder. aşağıda dosya yolunda kendi kullanıcı klasörün neyse onu yazman gerekiyor.

Sub dosyafarklikaydet()
    Set S1 = Sheets("Listele")
    Application.ScreenUpdating = False
    isim = Split(ThisWorkbook.Name, ".")(0)
    tarih = Format(Now, "dd-mm-yyyy")

 
    'Burada Eklemek istediğim sütunları seçili hale getiriyor.
    S1.Select
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N").Select
    Range("A1").Activate
    'Seçtiğim sütunlar kopyalanıyor
    Selection.Copy
    'yeni bir excel dosyası açılıp kopyalanan veriler yapıştırılıyor.
    Workbooks.Add
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
 


    'belirtilen yere dosyayı o günün tarihiyle kaydediyor
     ActiveWorkbook.SaveAs Filename:="C:\Users\kendikullanıcıklasörün\Desktop" & "\" & isim & "-" & tarih & ".xlsm", _
     FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
     ActiveWindow.Close
 
End Sub

 

[enboy81]

teşekkürler, ellerinize sağlık.