Sil hakkında

[polis-53]

Merhaba arkadaşlar aşağıda gönderdiğim kodda sil dediğimde satırı komple siliyor benim istediğim satır E sutununa kadar silsin ve kayıtlı verilerde birden çok benzer kayıt var ben hangisini seçersem o veriyi silsin şimdiden teşekkür ederim.
Private Sub CommandButton3_Click()
'S İ L
If DTPicker1 = "" Then
MsgBox "Lütfen Önce Listeden Seçim Yapınız.", vbCritical, "Dikkat !"
ListView1.SetFocus
Exit Sub
End If

Sheets("LİSTE").Select

Set S1 = Sheets("LİSTE")
Dim sat%
On Error GoTo hata

cevap = MsgBox("Silmek İstediğinizden Eminmisiniz ?", vbYesNo, "Silme Onayı")

If cevap = vbNo Then

For tem = 1 To 16
Controls("textbox" & tem) = Empty
Next

DTPicker1.Enabled = True
DTPicker1.SetFocus

Exit Sub
End If

Dim bak As Range
Dim syd As String
Dim Satir As Long
Set S1 = ThisWorkbook.Worksheets("LİSTE")
If cevap = vbYes Then
say = S1.Cells(65536, "b").End(3).Row
For Each bak In S1.Range("B2:B" & say)
ad = S1.Range(bak.Offset(0, 0).Address).Value
syd = S1.Range(bak.Offset(0, 1).Address).Value
' MsgBox ad & Syd
If StrConv(ad, vbUpperCase) = StrConv(DTPicker1, vbUpperCase) Then
If StrConv(syd, vbUpperCase) = StrConv(ComboBox5.Text, vbUpperCase) Then
bak.Select

S1.Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 40).Address(False, False)).Delete Shift:=xlUp
MsgBox "Veriniz Silinmiştir.", vbInformation, "Sil"
Exit For
' Exit Sub
End If
End If
Next bak
say = S1.Cells(65536, "b").End(3).Row
For i = 1 To say - 1
Cells(i + 1, 1) = i
Next i

End If

'A&F sütun aralığını A3 hücresi baz alınarak sıralatıyoruz
S1.Range("A2:E65536").Select
Selection.Sort Key1:=S1.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


ListView1.ListItems.Clear

'Kolanlara yenilenen verileri tekrar al
say = S1.Cells(65536, "A").End(3).Row
ListView1.ListItems.Clear
For i = 2 To say
Set liste1 = Me.ListView1.ListItems.Add(, , S1.Cells(i, "A").Value)
liste1.SubItems(1) = S1.Cells(i, "B").Value
liste1.SubItems(2) = S1.Cells(i, "C").Value
liste1.SubItems(3) = S1.Cells(i, "D").Value
liste1.SubItems(4) = S1.Cells(i, "E").Value
'liste1.SubItems(5) = S1.Cells(i, "F").Value
'liste1.SubItems(6) = S1.Cells(i, "G").Value
'liste1.SubItems(7) = S1.Cells(i, "H").Value
'liste1.SubItems(8) = S1.Cells(i, "I").Value
'liste1.SubItems(9) = S1.Cells(i, "J").Value
'liste1.SubItems(10) = S1.Cells(i, "K").Value
'liste1.SubItems(11) = S1.Cells(i, "L").Value
'liste1.SubItems(12) = S1.Cells(i, "M").Value
'liste1.SubItems(13) = S1.Cells(i, "N").Value
'liste1.SubItems(14) = S1.Cells(i, "O").Value
'liste1.SubItems(15) = S1.Cells(i, "P").Value
'liste1.SubItems(16) = S1.Cells(i, "Q").Value
'liste1.SubItems(17) = S1.Cells(i, "R").Value
'liste1.SubItems(18) = S1.Cells(i, "S").Value
'liste1.SubItems(19) = S1.Cells(i, "T").Value
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(S1.Cells(i + 1, 2), 1) = "*" Then
Me.ListView1.ListItems(i).ListSubItems(1).ForeColor = vbBlue
Me.ListView1.ListItems(i).ForeColor = vbBlue
End If

'eğer hücre başında (-) işareti var ise satırı kırmızı renklendir
If Left(S1.Cells(i + 1, 2), 1) = "-" Then
Me.ListView1.ListItems(i).ListSubItems(1).ForeColor = vbRed
Me.ListView1.ListItems(i).ForeColor = vbRed
End If



Next i
'ListViewde sayfa çizgileri
ListView1.FullRowSelect = True
ListView1.Gridlines = True

For tem = 1 To 5
Controls("textbox" & tem) = Empty
Next

DTPicker1.Enabled = True
CommandButton1.Enabled = True


DTPicker1.SetFocus
TextBox20.Text = ""

hata:

End Sub