DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
	Altın Üyelik Hakkında Bilgi
Sub Yedek_Al()
    On Error Resume Next
    Dim FSO As Object
    Dim MyFolder, MyFile, MyFileEnd As String
    Dim S As Long
    MyFolder = "D:\ARŞİV"
    MyFile = "YEDEK DOSYA ADINIZ"
    MyFileEnd = MyFile & " " & Format(Now, "dd mm yyyy") & ".xls"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FolderExists(MyFolder) Then
    FSO.CreateFolder (MyFolder)
    End If
    
    ActiveWorkbook.SaveCopyAs Filename:=MyFolder & Application.PathSeparator & MyFileEnd
    
    Set FSO = Nothing
    Workbooks.Open "D:\ARŞİV\" & MyFileEnd
    Application.DisplayAlerts = False
    Sheets("gun").Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub
	Sub SayfalariYeniKitaplaraAktar()
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    MyFolder = "D:\ARŞİV"
    MyFile = "YEDEK DOSYA ADINIZ" & " " & Format(Now, "dd mm yyyy") & ".xls"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(MyFolder) Then
        FSO.CreateFolder (MyFolder)
    End If
    Sheets(Array("as", "yıl")).Copy
    Set wb1 = ActiveWorkbook
    wb1.SaveAs Filename:=MyFolder & "\" & MyFile
    wb1.Close
    wb.Activate
Set wb = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
End Sub
	ActiveWorkbook.SaveCopyAs ............