Aktar sil kodu

[kemal turan]

merhaba,
Aşağıdaki kodu forumdan bulduklarımla hazırladım.
İşlemimizde listviewe çift tıklayarak ID NO yu textbox52 ye İŞLEM TARİHİ nide textbox53 e alıyorum.
Silinmek istenen satır bugünden önce ise silmeyi engelliyor.Değilse siliyor.
İsteğim silmeden önce silinmek istenen satırı "Silinenler" sahifesine aktarsın ondan sonra silsin.
Bold olan yeri bu işi için yapmaya çalıştım olmadı. Bold olan yer için yarım rica ediyorum.
Şunuda yapabilirsek sevinirim. Veritabanında veriler AB sutununa kadar Aktarmadan önce mesaj kutusu oluşturup silme nedenini yazdıktan sonra AC sutunundaki satıra silme nedenini yazarsak çok iyi olur.
Yani veri satırının neden silindiğini bilmek istiyorum.
Teşekkür ederim.

Private Sub CommandButton28_Click()
Dim bugün As Date
Dim tarıh As Date
bugün = Format(CDate(TextBox53.Value), "dd.mm.yyyy")
tarıh = Format(CDate(Date), "dd.mm.yyyy")
If bugün < tarıh Then
MsgBox "Geçmiş tarihli veri silme yetkiniz yoktur."
Exit Sub
Else
End If
Set s1 = Sheets("verıtabanı")
Dim bul As Range
For Each bul In Sheets("VERITABANI").Range("A2:A" & s1.Range("A65536").End(3).Row)
If bul.Value = ANASAYFA.TextBox52.Text Then
[B]Yeni = Sheets("silinenler").Cells(Rows.Count, "A").End(3).Row + 1
[B]bul.Rows.Copy Sheets("silinenler").Cells(Yeni, "A")[/B][/B]
bul.EntireRow.Delete
End If
Next bul
MsgBox "İŞLEM TAMAM"
lısteGuncelle
End Sub

 

[PLİNT]

Merhaba
Aşağıdaki ilgili bölümü değiştirerek denermisiniz?
Inputbox ile silme nedeni yazılması istenir.

[SIZE="2"]
Private Sub CommandButton28_Click()
'....
'.....kodlar
'......
'......
If bul.Value = ANASAYFA.TextBox52.Text Then
Yeni = Sheets("silinenler").Cells(Rows.Count, "A").End(3).Row + 1
[COLOR="Blue"]sor = InputBox("Silme nedeni")
If sor <> Empty Then
s1.Range("A" & bul.Row & ":AB" & bul.Row).Copy Sheets("silinenler").Cells(Yeni, "A")
Sheets("silinenler").Cells(Yeni, "AC") = sor
bul.EntireRow.Delete
Else
MsgBox "Silme işlemi yapılamadı"
Exit Sub
End If[/COLOR]
End If
Next bul
MsgBox "İŞLEM TAMAM"
lısteGuncelle
End Sub[/SIZE]

 

[kemal turan]

Merhaba Sn. Plint
Çok teşekkür ederim.Emeğinize sağlık.
Selametle kalınız.