Tek tuş ile sayfa2'yi bugünün tarihi ve anın saati ile kaydetme

[fatcem]

Merhabalar,

Formüller içeren 2 sayfa (sheet) bir dosyam var normalde sayfa 2 ye sağ tık taşı veya kopyala yeni kitap seçerek sayfa 2 yi manuel olarak tek başına kaydediyorum,
Bunu makro ile bir tuşa basarak dosya adının o anın tarih saat dakika ve saniyesi olarak kaydettirebilirmiyiz.

Teşekkürler.

 

[tamer42]

Merhabalar,

Formüller içeren 2 sayfa (sheet) bir dosyam var normalde sayfa 2 ye sağ tık taşı veya kopyala yeni kitap seçerek sayfa 2 yi manuel olarak tek başına kaydediyorum,
Bunu makro ile bir tuşa basarak dosya adının o anın tarih saat dakika ve saniyesi olarak kaydettirebilirmiyiz.

Teşekkürler.

Sub Test()

Dim dt As String,  ph As String

dt = Format(Date, "yyy_mm_dd_hh_mm")

    ThisWorkbook.Sheets("Sayfa2").Copy
    
    ph = ThisWorkbook.Path

    '~~> Save As  new workbook

    ActiveWorkbook.SaveAs ph & "\" & dt & ".xlsx", FileFormat:=51
    
    
End Sub

 

[hamitcan]

Aşağıdaki linkten yararlanabilirsiniz.

Aktif sayfayı kaydetme

Aktif sayfayı satır ve sütun yuksekliklerini korumak şartıyla masaüstüne arşiv klasörüne nasıl kaydederim. Yardımlarınız için teşekkürler

www.excel.web.tr

 

[fatcem]

Sub Test() Dim dt As String, ph As String dt = Format(Date, "yyy_mm_dd_hh_mm") ThisWorkbook.Sheets("Sayfa2").Copy ph = ThisWorkbook.Path '~~> Save As new workbook ActiveWorkbook.SaveAs ph & "\" & dt & ".xlsx", FileFormat:=51 End Sub

İlginiz için teşekkürler, çalışıyor, yalnız ben yazmayı unutmuşum, Var olan formüller ile değilde değerler ile kaydedilebilir mi?

 

[fatcem]

Merhaba, sanırım son surm gözden kaçtı birkez daha yardımlarınız ricadır

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfayi_Dosya_Olarak_Formulleri_Degere_Cevirip_Kaydet()
    Dim Sh As Worksheet, Yol As String, Dosya_Adi As String
    
    Set Sh = Sheets("Sayfa2")
    
    Yol = ThisWorkbook.Path
    Dosya_Adi = Yol & "\" & Replace(Now, ":", "_") & ".xlsx"
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Sh.Copy

    ActiveWorkbook.Sheets(1).Cells.Copy
    ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlValues
    ActiveWorkbook.Sheets(1).Range("A1").Select
    
    ActiveWorkbook.SaveAs Dosya_Adi, 51
    ActiveWorkbook.Close

    Set Sh = Nothing

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "Sayfa2 aşağıdaki konuma dosya olarak kayıt edilmiştir." & Chr(10) & Chr(10) & Dosya_Adi, vbInformation
End Sub