• DİKKAT

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

Sayfa yedekleme

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kod:
Sub Kaydet()
For i = 1 To Sheets.Count
    If Sheets(i).Name = CStr(Date) Then
        MsgBox "Bu gün için sayfa oluşturuldu.", vbCritical, "D İ K K A T !"
        Exit Sub
    End If
Next
    Sheets("PUANTAJ").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Date
End Sub

Bı kod ile sayfayı yedekliyorum.Ancak formüller ile birlikte yedekliyor.Kodda nasıl bşr düzenleme yapılmalı ki sadece sayfayı formüller olmadan değer ve biçim ile yedeklesin.
Teşekkürler.
 
Merhaba,
End Sub satırından önce aşağıdaki satırı ekleyip dener misiniz?
Kod:
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 
Merhaba,
End Sub satırından önce aşağıdaki satırı ekleyip dener misiniz?
Kod:
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

İlginize teşekkürler.Bir diğer sorun da aşağıdaki kod ile KBS sayfsını C altında dizine kayıt yapıyorum amncak .xlsm olarak kaydediyor.Bunu xls olarak kaydetmek için nasıl bir düzenleme yapılmalı.
Kod:
Sub kbs_olustur()
'
' kbs_olustur Makro.
'


Application.ScreenUpdating = False
Application.DisplayAlerts = False
klasor = "C:\EKDERS"
If CreateObject("Scripting.FileSystemObject").FolderExists(klasor) = False Then
MkDir klasor
End If
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If

dosya = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - Len(uzanti) - 1)
Sheets("KBS").Copy
Yedek_Dosya_Adı = dosya & Format(Now, " dd_mm_yyyy_hh_nn_ss") & uzanti
Kayıt_Yeri = klasor & "\" & Yedek_Dosya_Adı
ActiveWorkbook.SaveAs Kayıt_Yeri, FileFormat:=FileFormatNum
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.Dosyanız C:\EKDERS klasörünün içindedir."
End Sub
Teşekkürler.Ana dosya .xlsm uzantılı.
 
Merhaba,
Usta işi yazılmış bir kod.
Kod üzerinde biraz değişiklik gerktiriyor ama 2003 kullandığım için sonuçlarını test edememe gibi bir sorunum var.
Aşağıdaki şekilde dener misiniz?

Hatalı kod silindi.
 
Son düzenleme:
Olmadı.xlsm olarak kayıt yapıyor.
 
Olmadı.xlsm olarak kayıt yapıyor.

Merhaba,
Önceki mesajımdaki kodu unutalım.
Orjinal kodunuzdaki
Kod:
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
satırını aşağıdaki ile değiştirip dener misiniz?

Kod:
uzanti = Left(Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare)), 4)
 
Teşekkürler.
 
Arkadaşlar çalışmalarınız çok güzel.
İlaveten bir şey sormak istiyorum.
Bu yaptığımız çalışma çalışma kitabındaki sayfayı kopyalayıp başka yerde çalışma kitabı olarak kaydediyor.
Şunu yapma imkanımız var mı?
Çalışma kitabımızdaki (diyelimki şablon olarak kullanıyoruz bunu) bir sayfayı yine başka bir çalışma kitabına sayfa olarak ekleme imkanımız var mı yine sizin kullandığınız bu sistemle?
Misal ben her günü ayrı bir çalışma kitabında değilde
Bir ayı tek bir çalışma kitabında, ayın bütün günlerini ayrı ayrı sayfalarda görmek istiyorum mesela?
bunu gerçekleştirebilir miyiz?

----
buldum :) varmış :)
 
Son düzenleme:
Geri
Üst