Sub DeleteB()
Dim i As Long, j As Long, maxzeilen As Long
maxzeilen = Range("A2500:A2600 ").End(xlDown).Row
i = 1
j = 0
Do While i < maxzeilen
If Cells(i, 2).Value = "" Then ' wenn in der 2. Spalte nichts steht dann
Rows(i).Delete ' löschen !!
j = j + 1
If i + j >= maxzeilen Then Exit Sub
i = i - 1
End If
i = i + 1
Loop
End Sub