Try this:

Sub DelSomeRows()
DelRowsWith (15)
DelRowsWith (16)
DelRowsWith (25)
End Sub

Sub DelRowsWith(x)
Set MyRange = Intersect _
(ActiveSheet.Range("D:D"), ActiveSheet.UsedRange)
For Each MyCell In MyRange
If MyCell.Value = x Then
MyCell.EntireRow.Delete Shift:=xlUp
End If
Next
End Sub

Thank you very much , it works like a charm......

You may use following code:

Dim TotalRows As Integer
Dim Counter as Integer
TotalRows=Range("D65536").End(xlUp).Row
Range("D1").Activate
For Counter=1 to TotalRows
If Range("D"&Counter).Value=25 OR Range("D"&Counter).Value=15 OR
Range("D"&Counter).Value=16 Then
Rows(Counter).Delete
End If
ActiveCell.Offset(1,0).Select
Next

when i run the code , i get a message saying " run time  error '6' Overflow

The code worked for me.

Review your code, line wrapping in email messages can cause problems
with code.

This should wrap properly for you. I just made the lines of code
shorter without adjusting any elements of the code.

Sub DeleteCertainRows()
Dim TotalRows As Integer
Dim Counter As Integer
TotalRows = Range("D65536").End(xlUp).row
Range("D1").Activate
For Counter = 1 To TotalRows
If Range("D" & Counter).Value = 25 Or _
Range("D" & Counter).Value = 15 _
Or Range("D" & Counter).Value = 16 Then
Rows(Counter).Delete
End If
ActiveCell.Offset(1, 0).Select
Next

End Sub