DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Yedekle()
If MsgBox("Yedekleme İşlemi Başlatılsın mı?", vbInformation + vbYesNo, "Bilgi Mesajı") = vbNo Then
Exit Sub
End If
Dim Klasör As Object, Dizin As String, DosyaAdı As Variant
Set Klasör = CreateObject("Shell.Application").BrowseForFoldeR(0, "Dosyanın yedekleneceği Klasörü seçin !", 1)
If Klasör Is Nothing Then
MsgBox "İşleme devam edebilmek için lütfen Klasör seçiniz !", vbExclamation, "Dikkat !"
Exit Sub
End If
Application.ScreenUpdating = False
DosyaAdı = Date
Dizin = Klasör.Self.Path & "\" & DosyaAdı & ".xls"
Sheets(Array("Sayfa1", "Sayfa2", "Sayfa3")).Select
Sheets(Array("Sayfa1", "Sayfa2", "Sayfa3")).Copy
ActiveWorkbook.SaveAs Filename:=Dizin
ActiveWindow.Close
Application.ScreenUpdating = True
MsgBox "Yedekleme İşlemi tamamlanmıştır.", vbInformation
End Sub