Kod'da bir düzenleme yapılması

[asdsxx]

Arkadaşlar sizlerden bir yardım bekliyorum

Private Sub CommandButton1_Click()

  Dim lastRow As Long
    Dim i As Long
   
    lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
   
    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.CountA(Range("B" & i & ":C" & i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
End Sub

Arkadaşlar yukarıdaki kod şu an açılışıyor ama eksikliği şu:
"C2" hücresi boş ise işlem yapmıyor. Eğer "C2" hücresi dolu ise "C" sütunundaki boş satırları tüm satır olarak siliyor.
Bu kodu şu şekilde düzenleyebilirmiyiz:
"C" sütununu "C2" den başlayarak ("C2" çalışmanın gereği mutlaka boş oluyor) sadece "C" sütunundaki boş hücreleri kaldıracak. Tüm satırı kaldırmayacak.
Ben kodun başına:

 Range("C2").Select
    Selection.Delete Shift:=xlUp
    Range("C1").Select

ekleyerek "C2" Hücresini önce sildirip sonra işleme devam ediyor ama Tüm boş satırları değilde (bu durumda diğer sütunlardaki verilerde siliniyor) sadece "C" sütunundaki boş satırları silmesini yapamadım.

 

[KoNFiCuS]

Merhaba anladığım kadarı ile aşağıdaki kodu deneyebilir misiniz?

Private Sub CommandButton1_Click()

  Dim lastRow As Long
  On Error GoTo errorhandler
   
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
   
    Range(Cells(2, 3), Cells(lastRow, 3)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

errorhandler:

MsgBox "No empty cells"

End Sub

 

[asdsxx]

Merhaba anladığım kadarı ile aşağıdaki kodu deneyebilir misiniz?

Private Sub CommandButton1_Click()

  Dim lastRow As Long
  On Error GoTo errorhandler
  
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
  
    Range(Cells(2, 3), Cells(lastRow, 3)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

errorhandler:

MsgBox "No empty cells"

End Sub

Sayın Hocam ilginize çok teşekkür ederim.
Evet anlatmaya çalıştığım olay bu idi. Ancak ben yanlış anlamışım. anlattığın şekilde sizin uyarladığınız kod doğru çalışıyor ancak işi karıştırıyor. Dediğim gibi hata bende. Ben mantığı yanlış kurmuşum. Meğer ki kod ancak iki aşamalı olursa istediğim sonuç gerçekleşecekmiş. Benim olmasını istediğim şu idi:

1- Önce sadece "C2" hücresini silip "C" sütunundaki tüm verileri bir hücre yukarı kaydıracak
2- Sonra "B" ve "C" sütunundaki (Sadece "C" sütunu değil) tüm boş satırları silecek "A" sütununa dokunmayacak.

 

[KoNFiCuS]

Bu şekilde deneyiniz,

Private Sub CommandButton1_Click()

  Dim lastRow As Long
  On Error GoTo errorhandler
  
    lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
  
    Range("C2").Delete Shift:=xlUp
  
    Range(Cells(2, 2), Cells(lastRow, 3)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

Exit Sub

errorhandler:

MsgBox "No empty cells"

End Sub

 

[asdsxx]

Bu şekilde deneyiniz,

Private Sub CommandButton1_Click()

  Dim lastRow As Long
  On Error GoTo errorhandler
 
    lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
 
    Range("C2").Delete Shift:=xlUp
 
    Range(Cells(2, 2), Cells(lastRow, 3)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

Exit Sub

errorhandler:

MsgBox "No empty cells"

End Sub

Hocam örnek dosya ekledim. Kendimi hiç bu kadar dikkatsiz hissetmemiştim. Bu kez bir noktayı atlamışım.
örnek dosya gönderiyorum

 

[KoNFiCuS]

Keşke baştan örnek dosya olsaymış, sanırım çözümünüz alttaki kod.

Private Sub CommandButton4_Click()
Dim lastRow As Long
    Dim i As Long
    
    Range("C2").Delete Shift:=xlUp
    
    lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.CountA(Range("B" & i & ":C" & i)) = 0 Then
            Range("B" & i & ":C" & i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next i
End Sub

 

[veyselemre]

Sub test()
    If Range("C2").Value = "" Then
        Range("C2").Delete xlUp
        With Range("B2:B" & Cells(Rows.Count, 3).End(3).Row + 1)
            Intersect(.Cells.SpecialCells(4).EntireRow, _
                      .Cells.Offset(, 1).SpecialCells(4).EntireRow, _
                      Range("B:C")).Delete xlUp
        End With
    End If
End Sub

 

[asdsxx]

Keşke baştan örnek dosya olsaymış, sanırım çözümünüz alttaki kod.

Private Sub CommandButton4_Click()
Dim lastRow As Long
    Dim i As Long
   
    Range("C2").Delete Shift:=xlUp
   
    lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
   
    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.CountA(Range("B" & i & ":C" & i)) = 0 Then
            Range("B" & i & ":C" & i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next i
End Sub

Çok çok teşekkür ederim. Haklısınız. Soruyu yazınca anlattığımı düşünmüştüm. Ama bir tarafı ayrıntılı anlatayım derken diğer taraf gözden kaçmış.
Elinize sağlık. Hakkınızı helal edin. Hayırlı ramazanlar...

 

[asdsxx]

Sub test()
    If Range("C2").Value = "" Then
        Range("C2").Delete xlUp
        With Range("B2:B" & Cells(Rows.Count, 3).End(3).Row + 1)
            Intersect(.Cells.SpecialCells(4).EntireRow, _
                      .Cells.Offset(, 1).SpecialCells(4).EntireRow, _
                      Range("B:C")).Delete xlUp
        End With
    End If
End Sub

Veysel Emre Bey size de teşekkür ederim.
Alternatif bir kod. Sizin kodda çalışıyor.
Emeklerinize çok teşekkür ederim. İyiki bu topluluğu tanımışım. iyi ki varsınız...