Yedek alma kodunda biçimlerle yedek alma

[S.Yiğit]

Merhabalar,

Sn. Korhan beyin ekteki kodunu kullanıyorum. Tarihlerde 40583 gibi yedek alıyor. Yedek alma işleminde biçimleriyle yedek alabilir mi? Bu konuda yardımcı olur musunuz?

Not: Kullandığım başka kodlarda var.. Yedek için olanları aşağıda belirttim.. Yedek sayfasını görmek için F11 tuşuna basınız..

Sayfanın kod bölümü:

Dim Eski_Değer
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Satır = WorksheetFunction.CountA(Sheets("YEDEK").Range("A:A")) + 1
    Sheets("YEDEK").Cells(Satır, 1) = Satır - 1
    Sheets("YEDEK").Cells(Satır, 2) = Date
    Sheets("YEDEK").Cells(Satır, 3) = Time
    Sheets("YEDEK").Cells(Satır, 4) = Application.UserName
    Sheets("YEDEK").Cells(Satır, 5) = ActiveSheet.Name & "!" & Target.Address(1, 1)
    Sheets("YEDEK").Cells(Satır, 6) = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
    [COLOR=red]Sheets("YEDEK").Cells(Satır, 7) = IIf(Target = "", "Değer Silindi !", Target)[/COLOR]
    Sheets("YEDEK").Cells.EntireColumn.AutoFit
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Eski_Değer = Target
End Sub

Modül:

Sub GİZLE()
    Sheets("YEDEK").Visible = 2
End Sub
 
Sub GÖSTER()
    Sheets("YEDEK").Visible = -1
End Sub

ThisWorkbook:

Private Sub Workbook_Activate()
    Sheets("YEDEK").Visible = 2
    Application.OnKey "{F11}", "GÖSTER"
    Application.OnKey "{F12}", "GİZLE"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{F11}", ""
    Application.OnKey "{F12}", ""
End Sub
 
Private Sub Workbook_Deactivate()
    Application.OnKey "{F11}", ""
    Application.OnKey "{F12}", ""
End Sub
 
Private Sub Workbook_Open()
    Sheets("YEDEK").Visible = 2
    Application.OnKey "{F11}", "GÖSTER"
    Application.OnKey "{F12}", "GİZLE"
End Sub

 

[S.Yiğit]

Merhaba,

Yukarıdak, konuda yardım bekliyorum..

 

[Ömer]

Merhaba,

#1 nolu mesajda kırmızı ile boyadığım kod satırının yerine aşağıdakini kullanın.

IIf(Target = "", "Değer Silindi !", Target).Copy Sheets("YEDEK").Cells(Satır, 7)

.

 

[S.Yiğit]

Hocam çok teşekkür ederim.. İyi geceler..

 

[1mak1mak]

Merhaba,

#1 nolu mesajda kırmızı ile boyadığım kod satırının yerine aşağıdakini kullanın.

IIf(Target = "", "Değer Silindi !", Target).Copy Sheets("YEDEK").Cells(Satır, 7)

.

Dim Eski_Değer
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Satır = WorksheetFunction.CountA(Sheets("YEDEK").Range("A:A")) + 1
    Sheets("YEDEK").Cells(Satır, 1) = Satır - 1
    Sheets("YEDEK").Cells(Satır, 2) = Date
    Sheets("YEDEK").Cells(Satır, 3) = Time
    Sheets("YEDEK").Cells(Satır, 4) = Application.UserName
    Sheets("YEDEK").Cells(Satır, 5) = ActiveSheet.Name & "!" & Target.Address(1, 1)
    Sheets("YEDEK").Cells(Satır, 6) = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
    [COLOR=red]Sheets("YEDEK").Cells(Satır, 7) = IIf(Target = "", "Değer Silindi !", Target)[/COLOR]
    Sheets("YEDEK").Cells.EntireColumn.AutoFit
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Eski_Değer = Target
End Sub

Acaba Yukarıdaki kodu Tüm sayfadaki değişiklikler için değilde
Sadece 1.Hücredeki değişiklikleri takip ederek yedeklemek için nasıl yazmalıyız.
Mesela (Sayfa1 B98)

Teşekkürler