Listboxdan süzüleni sayfadan silmek?

[udentr2002]

merhaba arkadaşlar ekli dosyada textboxa girilen veriyi aktar butonuna bastığımızda listbox1 den süzüp süzüleni sayfa2 ye alıyor sayfa 2 ye aldığınıda listbox2'de gösteriyor Ben Listbox1 den süzdüğü verileri Sayfa1'den silmesini (O süzdüğü verilerin olduğu satırları komple silmesi) istiyorum bunun için nasıl bir kod eklemem lazım ilgilenen hocalarıma teşekkür ederim

 

[Selçuk1]

sn. udentr2002,

kodlarınıza kırmızı renkli satırı ilave ederseniz sanırım istediğiniz olacaktır.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim isim As Range
Set s1 = Sheets("sayfa2")
For Each isim In Sheets("Sayfa1").Range("a3:a" & Sheets("Sayfa1").Range("a65536").End(3).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
sat = WorksheetFunction.CountA([sayfa2!a:a]) + 1
s1.Range("a" & sat & ":t" & sat) = Range("a" & isim.Row & ":t" & isim.Row).Value
[B][COLOR=Red]Rows(isim.Row).Delete[/COLOR][/B]
End If
Next
ListBox2.RowSource = "sayfa2!a2:t" & s1.[a65536].End(3).Row
End Sub

 

[udentr2002]

hocam

Cevabın için teşekürler yanlız aynı veriden olanların hepsini silmiyor mesala aynı isimle başşlayan 4-5 tane giriş yapın deneyin hepsini silmiyor aynı verinin olduğu tüm satırların silinip sayfa 2 ye alınması için ne yapabiliriz??

 

[Selçuk1]

sn. udentr2002,

dediğiniz gibi denedim ve aynı isimden olan tüm kayıtları silip sayfa2 ye aktardı. herhangi bir problem göremedim? sizdeki sorun neden kaynaklandı acaba??

 

[udentr2002]

???

Bende neden silmiyor hocam ya sizin gönderdiğniz kod üzerinden deniyorum
ama silmiyorr

 

[udentr2002]

??

Sn hocam defalarca denedim ama süzülen tüm verileri silmiyor ya tekrar bi bakabilirmisiniz rica etsem

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim isim As Range
Set s1 = Sheets("sayfa2")
For Each isim In Sheets("Sayfa1").Range("a3:a" & Sheets("Sayfa1").Range("a65536").End(3).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
sat = WorksheetFunction.CountA([sayfa2!a:a]) + 1
s1.Range("a" & sat & ":t" & sat) = Range("a" & isim.Row & ":t" & isim.Row).Value
[COLOR=red]Rows(isim.Row).Delete[/COLOR]
End If
Next
ListBox2.RowSource = "sayfa2!a2:t" & s1.[a65536].End(3).Row
[COLOR=red]UserForm_Initialize
[/COLOR]End Sub

 

[udentr2002]

??

Hocam öncelikle gecenin bu vaktinde bile zaman ayırıp ilgilendiğiniz için teşekkür ederim ama malesef yine textbox 1 e yazdığım verilere ait tüm satırı silmedi ya kodu aynen yazdım
bendeki dosyayı gönderiyorum isterseniz bir deneyin mesala textbox1 e ibrahim yazın aktar tuşuna basarak deneyin
sonrada uden yazın deneyin göreceksiniz hocam

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim isim As Range
Set s1 = Sheets("sayfa2")
For Each isim In Sheets("Sayfa1").Range("a3:a" & Sheets("Sayfa1").Range("a65536").End(3).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
sat = WorksheetFunction.CountA([sayfa2!a:a]) + 1
s1.Range("a" & sat & ":t" & sat) = Range("a" & isim.Row & ":t" & isim.Row).Value
adr = adr & "," & isim.Row & ":" & isim.Row
End If
Next
Range(Right(adr, Len(adr) - 1)).Delete
ListBox2.RowSource = "sayfa2!a2:t" & s1.[a65536].End(3).Row
UserForm_Initialize
End Sub

 

[udentr2002]

)

Tamam hocam çok çok teşekkür ederim oldu bu defa tekrar gecenin bu vakti vakit ayırdığınız sorunumuzu çözdüğünüz için Allah razı olsuın hakkınızı helal edin iyi geceler