• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

sayfa yedeklemede sorun

  • Konbuyu başlatan Konbuyu başlatan ordulu82
  • Başlangıç tarihi Başlangıç tarihi
O

ordulu82

Altın Üye
Katılım
24 Mart 2006
Mesajlar
215
arkadaşlar sayfa yedeklemek için bir kod buldum.Ama bu kod sadece ilgili sayfayı belirtilen klasöre yedekliyor. fakat benim istediğim ilgili sayfanın "yedek" klasörünün içindeki bir çalşma kitabının içine sayfa sayfa kaydedilmesi.
 

Ekli dosyalar

Merhaba,

Dosyanızı açarken hata aldım. Bu sebeple inceleyemedim. Bende kendimce aşağıdaki kodu hazırladım. Sayfa ve dosya ismini kendinize göre değiştirirsiniz.

Yedeklenen sayfanın adı "Sayfa1" dir.

Yedekleme işlemi "C:YEDEK\" klasörüne yapılmaktadır. Klasörün olmaması kodun çalışmasına engel teşkil etmez. Klasör yoksa kod kendi oluşturur.

Dosya adı : YEDEK.xls
Sayfa ad : Yedek_1 (şeklinde devam ediyor...)

Kod: 
Option Explicit
 
Sub SAYFA_YEDEKLE()
    Dim Dosya_Sistemi As Object, K1 As Workbook, K2 As Workbook
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
 
    If Not Dosya_Sistemi.FolderExists("C:\YEDEK") Then
        Dosya_Sistemi.CreateFolder ("C:\YEDEK")
    End If
 
    If Dir("C:\YEDEK\YEDEK.xls") = "" Then
        Sheets("Sayfa1").Copy
        Application.DisplayAlerts = False
        ActiveSheet.Name = "Yedek_" & ActiveWorkbook.Sheets.Count
 
        ActiveWorkbook.SaveAs Filename:="C:\YEDEK\YEDEK.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
 
        ActiveWindow.Close
    Else
        Set K1 = ThisWorkbook
        Set K2 = Workbooks.Open("C:\YEDEK\YEDEK.xls")
        K1.Sheets("Sayfa1").Copy , K2.Sheets(K2.Sheets.Count)
        K2.Sheets(K2.Sheets.Count).Name = "Yedek_" & K2.Sheets.Count
        K2.Close True
    End If
 
    Set K1 = Nothing
    Set K2 = Nothing
    Set Dosya_Sistemi = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Dosyanızı açarken hata aldım. Bu sebeple inceleyemedim. Bende kendimce aşağıdaki kodu hazırladım. Sayfa ve dosya ismini kendinize göre değiştirirsiniz.

Yedeklenen sayfanın adı "Sayfa1" dir.

Yedekleme işlemi "C:YEDEK\" klasörüne yapılmaktadır. Klasörün olmaması kodun çalışmasına engel teşkil etmez. Klasör yoksa kod kendi oluşturur.

Dosya adı : YEDEK.xls
Sayfa ad : Yedek_1 (şeklinde devam ediyor...)

Kod: 
Option Explicit
 
Sub SAYFA_YEDEKLE()
    Dim Dosya_Sistemi As Object, K1 As Workbook, K2 As Workbook
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
 
    If Not Dosya_Sistemi.FolderExists("C:\YEDEK") Then
        Dosya_Sistemi.CreateFolder ("C:\YEDEK")
    End If
 
    If Dir("C:\YEDEK\YEDEK.xls") = "" Then
        Sheets("Sayfa1").Copy
        Application.DisplayAlerts = False
        ActiveSheet.Name = "Yedek_" & ActiveWorkbook.Sheets.Count
 
        ActiveWorkbook.SaveAs Filename:="C:\YEDEK\YEDEK.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
 
        ActiveWindow.Close
    Else
        Set K1 = ThisWorkbook
        Set K2 = Workbooks.Open("C:\YEDEK\YEDEK.xls")
        K1.Sheets("Sayfa1").Copy , K2.Sheets(K2.Sheets.Count)
        K2.Sheets(K2.Sheets.Count).Name = "Yedek_" & K2.Sheets.Count
        K2.Close True
    End If
 
    Set K1 = Nothing
    Set K2 = Nothing
    Set Dosya_Sistemi = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...

Üstadım yedek klasörünün içindeki dosyanın ismini "Maaş" olarak değiştirebilirmiyiz. bir de sayfaları yedek_1 eklinde değilde ocak,şubat,mart şeklinde nasıl sıralıyıcaz.Bende ilgili ayın adı e2 hücresinde yer alıyor.
 
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit
 
Sub SAYFA_YEDEKLE()
    Dim Dosya_Sistemi As Object, Sayfa_Adi As String, K1 As Workbook, K2 As Workbook
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
    
    If Not Dosya_Sistemi.FolderExists("C:\YEDEK") Then
        Dosya_Sistemi.CreateFolder ("C:\YEDEK")
    End If
    
    Sayfa_Adi = ActiveSheet.Range("E2")
    
    If Dir("C:\YEDEK\Maaş.xls") = "" Then
        ActiveSheet.Copy
        Application.DisplayAlerts = False
        ActiveSheet.Name = Sayfa_Adi
        
        ActiveWorkbook.SaveAs Filename:="C:\YEDEK\Maaş.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        ActiveWindow.Close
        MsgBox "Yedekleme işleminiz tamamlanmıştır.", vbInformation
    Else
        Set K2 = Workbooks.Open("C:\YEDEK\Maaş.xls")
        If Sayfa_Varmi(Sayfa_Adi) = False Then
            Set K1 = ThisWorkbook
            K1.ActiveSheet.Copy , K2.Sheets(K2.Sheets.Count)
            K2.Sheets(K2.Sheets.Count).Name = Sayfa_Adi
            K2.Close True
            MsgBox "Yedekleme işleminiz tamamlanmıştır.", vbInformation
        Else
            K2.Close True
            MsgBox Sayfa_Adi & " isimli sayfayı daha önce yedeklemişsiniz. İşleminiz iptal edilmiştir.", vbCritical
        End If
    End If
    
    Set K1 = Nothing
    Set K2 = Nothing
    Set Dosya_Sistemi = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Function Sayfa_Varmi(Sayfa_Adi As String) As Boolean
    On Error Resume Next
    Sayfa_Varmi = CBool(Worksheets(Sayfa_Adi).Name > 0)
End Function
 
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit
 
Sub SAYFA_YEDEKLE()
    Dim Dosya_Sistemi As Object, Sayfa_Adi As String, K1 As Workbook, K2 As Workbook
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
    
    If Not Dosya_Sistemi.FolderExists("C:\YEDEK") Then
        Dosya_Sistemi.CreateFolder ("C:\YEDEK")
    End If
    
    Sayfa_Adi = ActiveSheet.Range("E2")
    
    If Dir("C:\YEDEK\Maaş.xls") = "" Then
        ActiveSheet.Copy
        Application.DisplayAlerts = False
        ActiveSheet.Name = Sayfa_Adi
        
        ActiveWorkbook.SaveAs Filename:="C:\YEDEK\Maaş.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        ActiveWindow.Close
        MsgBox "Yedekleme işleminiz tamamlanmıştır.", vbInformation
    Else
        Set K2 = Workbooks.Open("C:\YEDEK\Maaş.xls")
        If Sayfa_Varmi(Sayfa_Adi) = False Then
            Set K1 = ThisWorkbook
            K1.ActiveSheet.Copy , K2.Sheets(K2.Sheets.Count)
            K2.Sheets(K2.Sheets.Count).Name = Sayfa_Adi
            K2.Close True
            MsgBox "Yedekleme işleminiz tamamlanmıştır.", vbInformation
        Else
            K2.Close True
            MsgBox Sayfa_Adi & " isimli sayfayı daha önce yedeklemişsiniz. İşleminiz iptal edilmiştir.", vbCritical
        End If
    End If
    
    Set K1 = Nothing
    Set K2 = Nothing
    Set Dosya_Sistemi = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Function Sayfa_Varmi(Sayfa_Adi As String) As Boolean
    On Error Resume Next
    Sayfa_Varmi = CBool(Worksheets(Sayfa_Adi).Name > 0)
End Function
Genişletmek için tıkla ...

Üstadım Eline sağlık tam anlamıyla mükemmel olmuş.
Hocam ben sayfa adını E2 hücresinden değilde başka bir hücreden almak istesem Sayfa_Adi = ActiveSheet.Range("E2") kodunu değiştirmem yeterli olur mu
 
Bahsettiğiniz satırı düzenlemeniz yeterli olur...
 
Korhan Ayhan' Alıntı:
Bahsettiğiniz satırı düzenlemeniz yeterli olur...
Genişletmek için tıkla ...
Korhan Hocam İlk sayfa yedeklemesi yapıyor. fakat daha sonra e2 hücresini değiştirdiğimde yani başka bir ay seçtiğimde 400 hatası verip yedekleme yapmıyor.Bir de bu yedeklemede formülleri dikkate almasa iyi olur. yani kopyala-özel yapıştır-değerler şeklinde nasıl bir düzenleme yapılabilir.
 
Son düzenleme:
ordulu82' Alıntı:
Korhan Hocam İlk sayfa yedeklemesi yapıyor. fakat daha sonra e2 hücresini değiştirdiğimde yani başka bir ay seçtiğimde 400 hatası verip yedekleme yapmıyor.Bir de bu yedeklemede formülleri dikkate almasa iyi olur. yani kopyala-özel yapıştır-değerler şeklinde nasıl bir düzenleme yapılabilir.
Genişletmek için tıkla ...

Ayni problemi bende yasiyorum.
Benimde excelde yapmak istedigim ayni sey var ayni klasorun icine tarihle kaydetmek. Korhan ustanin yaptigi makro sadece 1 kere calisiyor daha sonra 400 hatasi veriyor. Baska bir ay degil sacede günü degistirdigimde hata veriyor.
tesekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst