Otomatik deger silip yedekleme

[alphae]

Herkese iyi aksamlar. Bir sorunum var icerisinden cikamadim. umarim bana yardim edecek birilerini bulabilirim.
Ekte gondermis oldugum dosyada "Onay Kutusu" secildigi anda onun yaninda bulunan degerlerin silinip "Yedekleme" sayfasinda yedeklendigi tarihle birlikte alt alta kaydinin yapilmasi.
E4:E12 sari renkli olanlarda formul oldugu icin onun silinmemesi gerekiyor.
Simdiden tesekkurler

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[alphae]

Cok isime yarayacak tesekkur ederim Muygun.
Sana da iyi calismalar

 

[alphae]

Kodlamalari orjinal dosyaya aktardim degisiklikleri yaptim fakat calismiyor. Kodu incelermisiniz, nerede hata yaptim..
Asagidaki resme bakarsaniz calismanin orjinali gorebilirsiniz.

Kodun degismis hali:

Sub aktar_ve_sil()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("dispensing")
Set s2 = ThisWorkbook.Worksheets("Backup")
For i = 11 To s1.Range("i65536").End(xlUp).Row
If s1.Cells(i, 9) <> DO&#208;RU And s1.Cells(i, 2) <> "" Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = Date
s2.Cells(sonsatir, 2) = s1.Cells(i, 2)
s2.Cells(sonsatir, 3) = s1.Cells(i, 3)
s2.Cells(sonsatir, 4) = s1.Cells(i, 4)
s2.Cells(sonsatir, 5) = s1.Cells(i, 5)
s2.Cells(sonsatir, 6) = s1.Cells(i, 6)
s2.Cells(sonsatir, 7) = s1.Cells(i, 7)
s2.Cells(sonsatir, 8) = s1.Cells(i, 8)
s2.Cells(sonsatir, 9) = Application.UserName
s1.Cells(i, 2) = ""
s1.Cells(i, 3) = ""
s1.Cells(i, 4) = ""
s1.Cells(i, 5) = ""
s1.Cells(i, 6) = ""
s1.Cells(i, 8) = ""
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[alphae]

tamam sorunu cozdum. kutucuklara macroyu atamamisim.