Yedekleme

[irfancantr]

Sayın hocalarım sadece aktif olan sayfayı yeni bir kitap olarak D:\YEDEK klasörüne kayıt imkanı yok mu?

 

[halit3]

A1 hücresine dosya ismi yaz yeterli aşağıdaki kodu kullan

Sub farklı_kayıtet()
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
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = "D:\YEDEK\" & yeni_dosya_adı

On Error Resume Next
If Dir("D:\YEDEK\") = "" Then MkDir "D:\YEDEK\"
If Sheets(ActiveSheet.Name).Cells(1, 1).Value <> "" Then
DosyaSistemi.CopyFile Dosya, kayıt_yeri
Else
MsgBox "DOSYA ADI YAZILI DEĞİL"
End If
End If
End Sub

 

[irfancantr]

Günaydın,

Sayın halit3 hocam,elinize sağlık çok güzel olmuş aslında işimi görür fakat yeni kitabımızın içinde sadece aktif sayfanın kayıtlı olmasını sağlayabilir miyiz? Biz bu şekilde tüm sayfalarıyla beraber kayıt altına alıyoruz...!

 

[halit3]

kod;

Sub dosyaoluştur()
dosya_adı = ActiveWorkbook.Name
Sayfa_adı = ActiveSheet.Name
deger = InputBox("UYARI!" & Chr(10) & _
Chr(10) & " Yeni sayfa adını yazınız " & Chr(10) & Chr(10) & _
"", _
"DİKKAT !", "", , , "DEMO.HLP", 10)
On Error Resume Next
yeni_dosya_adı = deger & ".xls"
If Dir("D:\YEDEK\") = "" Then MkDir "D:\YEDEK\"
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.SaveAs "D:\YEDEK\" & yeni_dosya_adı
Set ExcelSheet = Nothing
Workbooks.Open Filename:="D:\YEDEK\" & yeni_dosya_adı
Sheets(ActiveSheet.Name).Name = "tt"
Windows(dosya_adı).Activate
Sheets(Sayfa_adı).Copy Before:=Workbooks(yeni_dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
Sheets(ActiveSheet.Name).Name = deger
ActiveSheet.DrawingObjects.Delete
Sheets(2).Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
ActiveWorkbook.Save
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_adı).Select
End Sub

 

[irfancantr]

Sizi uğraştırdım sayın halit3 . Elinize sağlık tam istediğim gibi olmuş.
Teşekkür ederim.