DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Delete_Rows_With_Zeros()
Dim Rng As Range, My_Range As Range
Application.ScreenUpdating = False
With Sheets("Sayfa1")
For Each Rng In .Range("P16:P" & .Cells(.Rows.Count, "P").End(3).Row)
If Rng.Value = 0 And Rng.Value <> "" Then
If My_Range Is Nothing Then
Set My_Range = Rng.Offset(, -15).Resize(, 16)
Else
Set My_Range = Union(My_Range, Rng.Offset(, -15).Resize(, 16))
End If
End If
Next
If Not My_Range Is Nothing Then My_Range.Delete Shift:=xlUp
End With
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub