Soru Sayfa Kopyalama / Yedekleme (Sadece Değerleri)

[reosman]

Sayın hocalarım,

Dim ad As String
ad = ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy")
If varmi(ad) Then
MsgBox "Aynı Kayıt Var.!", vbCritical, "Mükerrer Kayıt"
Exit Sub
End If
ActiveSheet.Copy After:=ActiveSheet
ActiveSheet.Name = ad
MsgBox "Kaydınız Tarihiyle Oluşturuldu.!", 15, "Başarılı Kayıt"

bu şekildeki kod ile sayfayı kopyalıyor, yedekliyorum.
Talebim kopyalama, yedeklemede sayfadaki sadece değerleri
kopyalasın, butonları, renkleri v.s. kopyalamasın. Saygılarımla.

 

[Ömer]

Merhaba,

Buradaki sayfayı ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy") adını vererek kopyalamaktaki amaç yedekleme için mi?

 

[reosman]

evet aynen hocam

 

[Ömer]

Deneyiniz.

Sub Kaydet()

    Dim d As String, S1 As Worksheet, ad As String
    
    Set S1 = Sheets(ActiveSheet.Name)
    ad = S1.Name & "_" & Format(Now, "dd.mm.yy_hh.nn")
    d = ThisWorkbook.Path & "\" & ad & ".xlsx"
    
    Application.ScreenUpdating = False
    Sheets.Add.Name = ad
    
    S1.Cells.Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Range("A1").Select
    Application.CutCopyMode = False
    
    ActiveSheet.Copy
    With ActiveWorkbook
        .SaveAs Filename:=d
        .Close
    End With
    
    Sheets(ad).Delete
    Application.ScreenUpdating = True
    
End Sub

 

[reosman]

Hocam çok teşekkür ederim. Ben tabi tam anlatamadım.
Hocam sayfa içeriğinde bulunan verileri alacak, diğer tasarımla alakalı kısımları, butonları v.s.
almayacak, ve aynı çalışma kitabında sekme olarak kaydedecek.

 

[reosman]

Bu hususta bilgi verilebilecek ustalarım size zahmet olacak.

 

[Ömer]

Ben sayfayı farklı klasöre yedekleme yapacağınız diye anlamıştım.
Kodların çalışacağı sayfa.. ve kodlar çalıştıktan sonra oluşacak sayfanın örnekleri olan bir dosya ekleyip ne yapılması gerektiğini detaylı açıklayınız.

 

[reosman]

Dim ad As String
ad = ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy")
If varmi(ad) Then
MsgBox "Aynı Kayıt Var.!", vbCritical, "Mükerrer Kayıt"
Exit Sub
End If
ActiveSheet.Copy After:=ActiveSheet
ActiveSheet.Name = ad
MsgBox "Kaydınız Tarihiyle Oluşturuldu.!", 15, "Başarılı Kayıt"

Hocam yukarıdaki kodlarla örneğin (İz_23.06.2021) adını vererek YENİ BİR SEKME oluşturarak bir anlamda yedekliyorum.
Yedeklediğim sayfa diğer sayfa ile birebir aynı. Talep ettiğim şudur;

Yedeklenen sayfada butonlar, hücre renkleri vesair olmasın. Sadece verileri, değerleri alsın.

Saygılarımla.

 

[Ömer]

Deneyiniz.

Dim ad As String, S1 As Worksheet
ad = ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy")
If varmi(ad) Then
MsgBox "Aynı Kayıt Var.!", vbCritical, "Mükerrer Kayıt"
Exit Sub
End If

Set S1 = Sheets(ActiveSheet.Name)
Sheets.Add.Name = ad
    
S1.Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Range("A1").Select
Application.CutCopyMode = False

MsgBox "Kaydınız Tarihiyle Oluşturuldu.!", 15, "Başarılı Kayıt"

 

[YUSUF44]

Deneyiniz:

Sub ekle()
Dim ad As String
eski = ActiveSheet.Name

ad = ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy")
For i = 1 To Sheets.Count
    If Sheets(i).Name = ad Then
        MsgBox "Aynı Kayıt Var.!", vbCritical, "Mükerrer Kayıt"
        Exit Sub
    End If
Next
Sheets.Add
ActiveSheet.Name = ad
Sheets(eski).Cells.Copy
ActiveSheet.[A1].PasteSpecial Paste:=xlValues

MsgBox "Kaydınız Tarihiyle Oluşturuldu.!", 15, "Başarılı Kayıt"
End Sub

 

[reosman]

Saygıdeğer Hocalarım,
İlginize çok teşekkür ederim. Deneyip bilgi vereceğim. ALLAH razı olsun.

 

[reosman]

Hocalarım son olarak yeni sekmeyi en sola oluşturabilirmi ?

 

[YUSUF44]

Sheets.Add kısmını

Sheets.Add before:=Sheets(1)

olarak değiştirin.

En son için ise

Sheets.Add After:=Sheets(Sheets.Count)

Olarak kullanabilirsiniz.

 

[reosman]

Çok teşekkür ederim. Hocalarım ellerinize sağlık. Harika oldu.