Dosya Adının Sonuna Tarih Ekleme

[Rheago]

Merhaba arkadaşlar. Aşağıdaki kodu bu sitede buldum. Açık olan excel sekmesini C ye kaydetmeye yarıyor. Ama çalıştıramadım bir türlü. Yeni kitap olarak açıyor ama kaydetmeyip hata veriyor makro. Bunu nasıl düzeltebilirim?
Ayrıca birkaç sorun var galiba kodda.
C ye kaydedeceği dosyanın adı sekme adıyla aynı olmalı.
Buna ek olarak dosya adının sonuna bugünün tarihini eklemesini nasıl sağlayabilirim?

Sub test()
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
dosyam = "İSİM"
ActiveWorkbook.SaveAs "C:\" & dosyam & ".xls", FileFormat:=xlNormal
ActiveWorkbook.Close
End Sub

 

[muratboz06]

Aşağıdaki kodu deneyiniz.

Sub Kaydet()
    Application.DisplayAlerts = False
    Dim SayfaAdi As String, Tarih As String, DosyaAdi As String
    SayfaAdi = ActiveSheet.Name
    Tarih = Format(Date, "dd-mm-yyyy")
    DosyaAdi = SayfaAdi & " " & Tarih
    ActiveWorkbook.SaveAs "C:\" & DosyaAdi & ".xls", FileFormat:=xlNormal
    Application.DisplayAlerts = True
    ActiveWorkbook.Close  'kayıt işlemi bittikten sonra dosyanın kapanmasını istemiyorsanız bu satırı siliniz.
End Sub

 

[Rheago]

Aşağıdaki kodu deneyiniz.

Sub Kaydet()
    Application.DisplayAlerts = False
    Dim SayfaAdi As String, Tarih As String, DosyaAdi As String
    SayfaAdi = ActiveSheet.Name
    Tarih = Format(Date, "dd-mm-yyyy")
    DosyaAdi = SayfaAdi & " " & Tarih
    ActiveWorkbook.SaveAs "C:\" & DosyaAdi & ".xls", FileFormat:=xlNormal
    Application.DisplayAlerts = True
    ActiveWorkbook.Close  'kayıt işlemi bittikten sonra dosyanın kapanmasını istemiyorsanız bu satırı siliniz.
End Sub

Merhaba hocam. Hata verdi malesef.

 

[burhancavus61]

Denermisiniz tarih ve saat

Sub test()
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
dosyam = "İSİM"
ActiveWorkbook.SaveAs "C:\" & dosyam & Format(Now, "ddmmyy") & "-" & Format(Now, "hhmm") &".xls", FileFormat:=xlNormal
ActiveWorkbook.Close
End Sub

 

[Rheago]

Denermisiniz tarih ve saat

Sub test()
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
dosyam = "İSİM"
ActiveWorkbook.SaveAs "C:\" & dosyam & Format(Now, "ddmmyy") & "-" & Format(Now, "hhmm") &".xls", FileFormat:=xlNormal
ActiveWorkbook.Close
End Sub

İlginize teşekkür ederim. Bu makro mevcut sekmeyi ayrı dosyada açıp hata veriyor.

 

[burhancavus61]

c: dizini altına yazma yetkiniz varmı hata ondandır. bende c altıma yedek klasörü oluşturdum makro çalıştı.

Sub test()
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
dosyam = "İSİM"
ActiveWorkbook.SaveAs "C:\YEDEK\" & dosyam & Format(Now, "ddmmyy") & Format(Now, "hhmm") & ".xls"
ActiveWorkbook.Close
End Sub

 

[Rheago]

c: dizini altına yazma yetkiniz varmı hata ondandır. bende c altıma yedek klasörü oluşturdum makro çalıştı.

Sub test()
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
dosyam = "İSİM"
ActiveWorkbook.SaveAs "C:\YEDEK\" & dosyam & Format(Now, "ddmmyy") & Format(Now, "hhmm") & ".xls"
ActiveWorkbook.Close
End Sub

Merhaba hocam. Kaydetme sorununu çözdüm. Sizin paylaştığınız kodu kendime göre düzenledim. Kaydetmede problem fakat şöyle bir eksik çıktı. Bir çalışma kitabında 3 tane sekme var diyelim. Bu kod o an ekranımda açık olan sekmeyi değilde 1. sıradaki sekmeyi kaydediyor. Ben sadece ekranımda açık olan sekmeyi kaydetsin istiyorum. Öyle bir şey mümkün değilse sekme adını manuel nasıl değiştirebilirim?

Sub test()
Dim SayfaAdi As String
SayfaAdi = ActiveSheet.Name
Set ktp = Workbooks.Add(1)
ThisWorkbook.Sheets(1).Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.SaveAs "C:\Users\YB129\Desktop\İŞ DOSYALARI\TEKNİK FORM\" & SayfaAdi & Format(Now, " dd-mm-yyyy") & ".xls", FileFormat:=xlNormal
ActiveWorkbook.Close
End Sub

 

[Rheago]

Arkadaşlar desteğiniz için çok teşekkür ederim. Paylaşılan kodları aşağıdaki gibi revize ederek istediğim hale getirdim.

Sub test()
Dim SayfaAdi As String
SayfaAdi = ActiveSheet.Name
Set ktp = Workbooks.Add(1)
ThisWorkbook.ActiveSheet.Cells.Copy
ktp.Sheets(1).Cells(1).PasteSpecial
ktp.Sheets(1).Name = SayfaAdi
Application.CutCopyMode = False
ActiveWorkbook.SaveAs "C:\Users\Bilgisayar\Desktop\" & SayfaAdi & Format(Now, " dd-mm-yyyy") & ".xlsx", FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close
End Sub