Soru Listboxta Seçilen Hücreyi Temizle ve Altındaki Dolu Hücreleri Üstündeki İlk Boş Dolu Hücreye Kadar Taşı

[TURKOLOG]

Private Sub Sil_Click()
Dim bul As Range
If ListBox1.ListCount = 0 Then Exit Sub
Set bul = Sheets("KONTROL").Range("P:P").Find(ListBox1.Value, LookAt:=xlWhole)
If Not bul Is Nothing Then
Sheets("KONTROL").Rows(bul.Row).Delete
End If
UserForm_Initialize
End Sub

Yukarıdaki kodla listBox1'de seçilip textBox1 e getirilen kaydı Kontrol sayfası P2: P aralığında bulup silebiliyorum

Aşağıdaki kodla da listBox1'de seçilip textBox1 e getirilen kaydı Kontrol sayfası P2: P aralığında buluyor ama malesef :Kontrol sayfasında hangi satırda ise o satırın tamamını temizliyor.
Benim istediğim ise Temizle kodunu çalıştırınca listBox1'de seçilip textBox1 e getirilen kaydı Kontrol sayfası P2: P aralığında bulunması ve sadece P stütununda yazılı olduğu hücrenin temizlenmesi ve temizlenen hücrenin altında dolu hücreler varsa eğer dolu hücrelerin ilk boş hücreye kadar yukarı taşınması

örnek: P Sütununda 2. satırdan itibaren hcrelerin dolu olduğunu varsayarsak
P2 Ali
P3 Mehmet
P4 Şükrü
P5 Veli
P6 Ziya yazıyorsa ve Mehmet yazılı hücre temizlenecekse
işlemden sonraki yeni hali Ama satırlar silinmeyecek çünkü her satırda farklı veri var

P2 Ali
P3 Şükrü
P4 Veli
P5 Ziya

YARDIMCI OLABİLECEK OLAN VARSA ÇOK SEVİNİRİM

Private Sub Temizle_Click()
Dim bul As Range
If ListBox1.ListCount = 0 Then Exit Sub
Set bul = Sheets("KONTROL").Range("P:P").Find(ListBox1.Value, LookAt:=xlWhole)
If Not bul Is Nothing Then
Sheets("KONTROL").Rows(bul.Row).Clear
End If
UserForm_Initialize
End Sub

Temizle kodu malesef tüm satırı temizliyor. Ve de P sutununda temizlediği satırın altında yazılı veri varsa yukarı taşımıyor.

 

[muygun]

Merhaba;
Sayfada işlem yapan aşağıdaki kodu userforma adapte edin
İyi çalışmalar.

Sub Sill()
Application.ScreenUpdating = False
Dim i As Long, son As Long
son = [p65536].End(3).Row
For i = son To 2 Step -1
If Cells(i, "p") = "Mehmet" Then
Range("P" & i).Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[TURKOLOG]

Merhaba;
Sayfada işlem yapan aşağıdaki kodu userforma adapte edin
İyi çalışmalar.

Sub Sill()
Application.ScreenUpdating = False
Dim i As Long, son As Long
son = [p65536].End(3).Row
For i = son To 2 Step -1
If Cells(i, "p") = "Mehmet" Then
Range("P" & i).Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub

Hocam çok teşekkür ederim elinize emeğinize sağlık kodu aşağıdaki şekilde revize etim. İhtiyacı olanlar için kodu paylaşıyorum.

Private Sub Temizle_Click()
Application.ScreenUpdating = False
Dim i As Long, son As Long
son = [p65536].End(3).Row
For i = son To 2 Step -1
If Cells(i, "p") = TextBox1.Text Then
Range("P" & i).Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
UserForm_Initialize
End Sub