Dosyayı Farklı Kaydetmek

1. Aynı formatta dosyayı farklı kaydetmek:

Sub saveas()

'Öncelikle mevcut çalışmamızı kaydediyoruz

ThisWorkbook.Save

'Tüm sayfaları seçin, sayfalardaki tüm hücreleri kopyalayıp değer yapıştırın

Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues

'Çalışma kitabını Farklı Kaydet ile kaydedin (saveas)

'Bu çalışma kitabıyla aynı dizine kaydedin. Yeni çalışma kitabının başına "DOSYA_" ibaresi koyun

'Bugünün tarihini " DOSYA_"dan sonra "yymmdd" biçiminde ekleyin, böylece dosya adı DOSYA_yymmdd_urunler" gibi görünecektir.

ThisWorkbook.saveas Filename:=ThisWorkbook.Path & "\DOSYA_" & VBA.Format(VBA.Date, "YYMMDD") & _
"_" & ThisWorkbook.Name

End Sub

2. Aynı formatta dosyayı değişken kullanarak farklı kaydetmek:

Sub kaydet()

    Dim DosyaYolu As String
    Dim DosyaAdi As String
    
    DosyaYolu = ThisWorkbook.Path & "\"
    DosyaAdi = "Dosya_" & VBA.Format(Date, "yymmdd") & "_" & ThisWorkbook.Name
    
    ThisWorkbook.Save
    Sheets.Select
    Cells.Copy
    Cells.PasteSpecial xlPasteValues
    
    Sheets(1).Select
    Range("A1").Select
    ThisWorkbook.SaveAs Filename:=DosyaYolu & DosyaAdi
    
End Sub

3. Makro içeren dosyayı dosyayı xlsx formatında kaydetmek:

Sub saveas2()

'Öncelikle mevcut çalışmamızı kaydediyoruz

ThisWorkbook.Save

'Tüm sayfaları seçin, sayfalardaki tüm hücreleri kopyalayıp değer yapıştırın

Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues

Application.DisplayAlerts = False

'Çalışma kitabını Farklı Kaydet ile kaydedin (saveas)

'Bu çalışma kitabıyla aynı dizine kaydedin. Yeni çalışma kitabının başına "DOSYA_" ibaresi koyun

"Bugünün tarihini " DOSYA_"dan sonra "yymmdd" biçiminde ekleyin, böylece dosya adı DOSYA_yymmdd_urunler" gibi görünecektir.

'Kopyayı makrosuz kaydedin (yani kopyalanan sürüm normal bir xlsx dosyası olmalıdır)

ThisWorkbook.saveas Filename:=ThisWorkbook.Path & "\DOSYA_" & VBA.Format(VBA.Date, "YYMMDD") & _
"_" & VBA.Replace(ThisWorkbook.Name, ".xlsm", ""), FileFormat:=Excel.xlOpenXMLWorkbook

Application.DisplayAlerts = True

End Sub

Paylaş: