Excel Dosyasını Değer ve Biçim Olarak Yedekleme Yapmak

[asmirk]

Merhaba Arkadaslar is yerim için formüllere dayali bir dosya ayarliyorum. Çok fazla formül oldugundan dolayi dosyanin boyutuda dogal olarak büyük oluyor. Bide ben bu dosyadan hergün 1 adet back-up almam lazim tablolarimda bir hücrede o günü gösteren formül mevcut ve dogal olarak çalistigim günü gösteriyor. Simdi benim sormak istedigim su ;

Benim bu dosyamda yaklasik olarak 12 sayfa var ve ilk sayfasina olusturacagim buttona basinca bana ayni kilasörde bulundugu yerde bu günkü tarih adinda bir exel dosyasi acarak içine sadece biçimlendirmeleri ve degerleri kopyalayacak bir makro olabilir mi? Dogal olarakta sadece biçimlendirmeler ve degerler yazilinca hem tarih sabit kalacak hem de formüller olmadigindan dolayi dosya boyutu çok küçülecektir.

Bu konuda ustalarimiz bana yardimci olurlarsa çok sevinecem.

Saygilarimla..

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Sayfa1 A1 hücresindeki tarih ile dosyayı bulunduğu yola yedekler.

Option Explicit
 
Sub DOSYAYI_YEDEKLE()
    Dim YEDEK_DOSYA_ADI As String
    Dim DOSYA_YOLU As String
    Dim X As Integer
 
    YEDEK_DOSYA_ADI = Format(Sheets("Sayfa1").Range("A1"), "dd.mm.yyyy") & ".xls"
    DOSYA_YOLU = ThisWorkbook.Path & "\"
 
    Application.ScreenUpdating = False
 
    Sheets(Array("Sayfa2", "Sayfa3", "Sayfa4", "Sayfa5", "Sayfa6", "Sayfa7", "Sayfa8", "Sayfa9", "Sayfa10", "Sayfa11", "Sayfa12")).Copy
 
    Application.ScreenUpdating = False
    For X = 1 To Sheets.Count
    Sheets(X).Select
[COLOR=red]        [B]ActiveSheet.Unprotect "12345"[/B][/COLOR]
        Cells.Copy
        [A1].PasteSpecial Paste:=xlPasteValues
        [A1].PasteSpecial Paste:=xlPasteFormats
        [A1].Select
        Application.CutCopyMode = False
[COLOR=red]        [B]ActiveSheet.Protect "12345"[/B][/COLOR]
    Next
    Sheets(1).Select
 
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=DOSYA_YOLU & YEDEK_DOSYA_ADI, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWindow.Close
    Application.ScreenUpdating = True
 
    Sheets(1).Select
    MsgBox "Yedekleme işlemi tamamlanmıştır.", vbInformation
End Sub

 

[Yakut]

slm

bugün aynen böyle bir düsünce gecmisti.

her iki arkasa asmirk ve korhan ayhan tesekkürler

saygilar

 

[asmirk]

Sevgili Korhan Ayhan Ustam Verdiginiz emege cok tesekkur ederim sistem isliyor lakin resimdeki gibi bir hata veriyor dosyanin ismini tarihle ayn1 degilde kitap1 diye olusturup res1mdeki hatayi veriyor. Bunun nedeni ne olabilir acaba? Bu arada Yakut arkadasim sanada iyi çalismalar.

Saygilarimla çok tesekkür ederim.

 

[Korhan Ayhan]

Selamlar,

A1 hücresindeki tarhi formatından kaynaklanıyor.

Hücre biçimini gg.aa.yyyy şeklinde ayarlarsanız sorun kalmayacaktır.

 

[asmirk]

Maalesef sevgili Korhan Ayhan bey ayni hatayi veriyor

 

[asmirk]

Kopyalamasini istedigim yer bu koddaki mi olacak acaba ?

DOSYA_YOLU = ThisWorkbook.Path & "\"

çalisma kitabinin kayit edilmesini istedigimiz yer? Çunku hatada "abdul" diyor benim bilgisayar1m kara diye kayitli.

 

[asmirk]

Sorun benden kaynaklanıyormuş Küçük bir format ile sorun çözüldü

Lakin dosyamda daha öncede belirtiğim gibi çok formül var bu yüzden şifreli korumaya alıyorum. Sifreli koruma eklediğim zaman makro kopyalanmaya izin vermediği için salt okunur olarak dosya gözüktüğünden işlemi tamamlayamiyor malesef. Acaba buna ne gibi bir çözüm getirebilir? Mesela bir tuş ile şifreli korumaları (bütün sayfaların şifreleri ayn&#305 şifre girerek kaldırmanın ve yine bir tuşla aynı korumayı istediğimiz şifreyi girerek yedekleme bittikten sonra eski haline gelebilmesi için gibi, ya da ilk makromuzda bir değişiklik yaparak sonuca ulaşmamız mümkün müydü? acaba.

Ustalarım bu konuda da yardımcı olurlarsa çok sevineceğim.

Saygılarımla...

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı güncelledim. İncelermisiniz. Kırmızı renkli bölümlere kendi şifrenizi girerek deneyin.

 

[asmirk]

Selamlar,

Üstteki mesajımdaki dosyayı güncelledim. İncelermisiniz. Kırmızı renkli bölümlere kendi şifrenizi girerek deneyin.

Yardımlarınız için çok teşekkür ederim Sayın Korhan Ayan bey çok faydası oldu bana

Saygılarımla...