(18/01/2020, 12:19)accessman yazdı: teşekkürler feraz

(18/01/2020, 13:39)accessman yazdı: Çok kısa bir yöntemden bahsetmiştiniz

Range("A3:A15").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Dim SonStR, x As Long

Dim HcrAdrs, SonStN As String

HcrAdrs = Mid(Range("A1").SpecialCells(xlCellTypeLastCell).Address, 2) 'son hücrenin adresi

SonStN = Left(HcrAdrs, InStr(HcrAdrs, "$") - 1) 'son sütun

SonStR = Mid(HcrAdrs, InStr(HcrAdrs, "$") + 1) 'son satır

        Application.ScreenUpdating = False

 

        For I = SonStR To 1 Step -1 'son satırdan ilk satıra kadar döngü kurduk

            If Application.WorksheetFunction.CountA(Range("A" & I & ":" & SonStN & I)) = 0 Then 'Eğer tüm satır boşsa

                Rows(I).EntireRow.Delete ' Tüm satırı sil

            End If

        Next

 

        Application.ScreenUpdating = True

        Debug.Print "bitti"