Gün Sonu Raporu

[ywzyilmaz]

Merhaba arkadaşlar

makrolar ile etiket ürettirmek için kullandığım bir Excel kitabı var. Tabi ki gün içerisinde basılan tüm etiketler Rapor aldı sayfada kayıt altına alınıyor. Günlük on bin kadar satır üretiyor e haliyle çalışma kitabı feci halde kasıyor.

Butona tıkladığımda makronun yapmasını istediğim şey şu ;

1. Rapor sayfasını yeni bir kitap oluşturup oraya kopyala
2. Oluşturduğun yeni kitabın adını o an ki tarih ve saat olarak ayarla
3. Kitabı ana Excel dosyasının veri yoluna "/Raporlar" klasörünün içerisine kaydet
4. Yeni oluşturulan dosyayı kapat.

Bu işlemleri yapacak bir makroya ihtiyacım var. Forumda benzer bir konu buldum fakat düzenleme yapamadım. Yardımcı olabilirseniz çok sevinirim.

 

[AdemCan]

Merhaba, istediğiniz işlemi yapan kodlar.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, yol As String, ad As String

Set s1 = Sheets("Rapor")
yol = ThisWorkbook.Path & "\Raporlar\"
ad = Format(Now, "dd.mm.yyyy hh_ss_nn") & ".xlsx"

s1.Copy
ActiveWorkbook.SaveAs yol & ad
ActiveWindow.Close

Set s1 = Nothing
yol = Empty
ad = Empty
Application.ScreenUpdating = True
End Sub

 

[ywzyilmaz]

Merhaba, istediğiniz işlemi yapan kodlar.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, yol As String, ad As String

Set s1 = Sheets("Rapor")
yol = ThisWorkbook.Path & "\Raporlar\"
ad = Format(Now, "dd.mm.yyyy hh_ss_nn") & ".xlsx"

s1.Copy
ActiveWorkbook.SaveAs yol & ad
ActiveWindow.Close

Set s1 = Nothing
yol = Empty
ad = Empty
Application.ScreenUpdating = True
End Sub

Çok teşekkür ederim tam istediğim gibi çalıştı. Ama bir şeyi unuttum, rapor sayfasını yeni dosyaya aktardık fakat ana dosyadaki rapor sayfasını temizlemeyi unuttuk.

Rapor sayfasında ; İlk satırda başlıklar var (A:H arası) ilk satır hariç tüm sayfayı temizlemesi gerekiyor.

 

[ywzyilmaz]

Çok teşekkür ederim tam istediğim gibi çalıştı. Ama bir şeyi unuttum, rapor sayfasını yeni dosyaya aktardık fakat ana dosyadaki rapor sayfasını temizlemeyi unuttuk.

Rapor sayfasında ; İlk satırda başlıklar var (A:H arası) ilk satır hariç tüm sayfayı temizlemesi gerekiyor.

Şu şekilde çözdüm. Ama seçme silme yaptığı için işlem yavaş dönüyor. Farklı bir öneriniz varsa alabilirim

Sub raportemizle()
    Sayfa5.Activate
    Range("A3:H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sayfa1.Activate
    Range("E2").Select
    ActiveWorkbook.Save
End Sub

 

[AdemCan]

Rica ederim. İşlem sonrası rapor sayfasının temizlenmesi için kodu güncelledim.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, yol As String, ad As String
Dim son As Long

Set s1 = Sheets("Rapor")
yol = ThisWorkbook.Path & "\Raporlar\"
ad = Format(Now, "dd.mm.yyyy hh_nn_ss") & ".xlsx"

s1.Copy
ActiveWorkbook.SaveAs yol & ad
ActiveWindow.Close

son = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A2:H" & son + 1).Clear

Set s1 = Nothing
yol = Empty
ad = Empty
son = 0
Application.ScreenUpdating = True
End Sub

 

[ywzyilmaz]

Rica ederim. İşlem sonrası rapor sayfasının temizlenmesi için kodu güncelledim.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, yol As String, ad As String
Dim son As Long

Set s1 = Sheets("Rapor")
yol = ThisWorkbook.Path & "\Raporlar\"
ad = Format(Now, "dd.mm.yyyy hh_nn_ss") & ".xlsx"

s1.Copy
ActiveWorkbook.SaveAs yol & ad
ActiveWindow.Close

son = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A2:H" & son + 1).Clear

Set s1 = Nothing
yol = Empty
ad = Empty
son = 0
Application.ScreenUpdating = True
End Sub

Çok teşekkür ederim.