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 ............