farkli kaydet

[edkaya]

excelde butona basında farklı kaydet olarak "gg/aa/yyyy (değişmeyen sabit dosya adı)" olacak şekilde herhangi verilen bir hedefe veya aynı klasörün içine farklı kaydetme için kullanılacak kod nasıl yapılmalıdır?

dosya ismi

tarih_sabit ad olacak şekilde..

 

[asmirk]

Sub DOSYAYI_YEDEKLE()
Dim YEDEK_DOSYA_ADI As String
Dim DOSYA_YOLU As String
Dim X As Integer

YEDEK_DOSYA_ADI = Sheets("veri").Range("A1") & ".xls"
DOSYA_YOLU = ThisWorkbook.Path & "\"

Application.ScreenUpdating = False

Sheets(Array("Sevki", "Delal", "Gokhan", "Ozan", "Ahmet", "Irfan", "Ali", "Selda", "Asli", "Cenk", "Hasila")).Copy

Application.ScreenUpdating = False
For X = 1 To Sheets.Count
Sheets(X).Select
ActiveSheet.Unprotect "xanadu"
Cells.Copy
[A1].PasteSpecial Paste:=xlPasteValues
[A1].PasteSpecial Paste:=xlPasteFormats
[A1].Select
Application.CutCopyMode = False
ActiveSheet.Protect "xanadu"
Next
Sheets(1).Select

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=DOSYA_YOLU & YEDEK_DOSYA_ADI, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWindow.Close
Application.ScreenUpdating = True

Sheets(2).Select
MsgBox "Yedekleme işlemi tamamlanmıştır.", vbInformation
End Sub



YEDEK_DOSYA_ADI = Sheets("veri").Range("A1") & ".xls" burada A1 hücresine tarihi eklersen sayfayı o isimde kayıt edecektir.


Sheets(Array("Sayfa_1", "Sayfa_2", "Sayfa_3")).Copy

Buraya da kayıt etmek istediğin sayfaları girersin

Sheets name lerini mesela ahmet

Application.ScreenUpdating = False
For X = 1 To Sheets.Count
Sheets(X).Select
ActiveSheet.Unprotect "xanadu"
Cells.Copy
[A1].PasteSpecial Paste:=xlPasteValues
[A1].PasteSpecial Paste:=xlPasteFormats
[A1].Select
Application.CutCopyMode = False
ActiveSheet.Protect ""xanadu"

Bu arada sayfanıda bu kod ile kopyalamaya karşı korumaya alıyorsun sifre 1"xanadu". Kayıt edilen dosyada sadece valueler (değerler olur) yazdığın formüller gözükmez. Çünkü bazı dosyalar formüller yüzünden çok yer kaplıyor. Bununla birlikte önüne geçebiliyoruz. Önemli dosyaların Backup ı için çok iyi oluyor
Not:Kodlar excel.web.tr ustalarımızdan alıntı yapılıp düzenlenmiştir Hepsine teşekkür ederim. Hepsinin emeklerine saygı ve sağlık

Kolay gelsin

 

[halit3]

Sub farklı_kayıtet()
kayıt = MsgBox("Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
ChDrive "c"
ChDir "c:\"
Application.Dialogs(xlDialogSaveAs).Show
End If
End Sub

 

[edkaya]

Sub farklı_kayıtet()
kayıt = MsgBox("Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
ChDrive "c"
ChDir "c:\"
Application.Dialogs(xlDialogSaveAs).Show
End If
End Sub

burda tekrar sormaması, direk tıklanınca A1 deki bilgiye göre C:\ nin içine direk farklı kaydetmesi için. nasıl düzenleyebiliriz.

 

[halit3]

Sub farklı_kayıtet()
kayıt_dosyası = Sheets(ActiveSheet.Name).Cells(1, 1).Value & ".xls"
kayıt = MsgBox(kayıt_dosyası & " olarak Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
ChDrive "c"
ChDir "c:\"
ActiveWorkbook.SaveAs Filename:=kayıt_dosyası
End If
End Sub

 

[halit3]

buda başaka farklı kayıt et



Sub farklı_kayıtet()
If Sheets(ActiveSheet.Name).Cells(1, 1).Value <> "" Then
yeni_dosya_adı = Sheets(ActiveSheet.Name).Cells(1, 1).Value & ".xls"
kayıt = MsgBox(yeni_dosya_adı & " olarak Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
ActiveWorkbook.SaveAs
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = "C:\" & yeni_dosya_adı
DosyaSistemi.CopyFile Dosya, kayıt_yeri
End If
Else
MsgBox "DOSYA ADI YAZILI DEĞİL"
End If
End Sub

 

[edkaya]

tesekkur ederim

 

[EXCELL PLATİNİUM]

arkadaşlar aslında benim tam olarak aradığım şey bu ancak. ben bunları yapamıyorum. nereden nasıl yapacağımıda bilmiyorum. yardımcı olursanız sevinirim.