Удаление пустых строк в определенном диапазоне

Sub www1()
    Range("A1:A10").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Option Explicit
Option Base 1
 
Public Sub ShadeEverySecondRow()
 
Application.ScreenUpdating = False
 
Dim i As Integer
Dim m As Integer
Dim k As Integer
 
Dim f As Integer
Dim y As Integer
 
Dim Array1(20) As Integer
Dim Array2(20) As Integer
 
Dim Array3 As Variant
Dim q As Integer, qq As Integer
 
Array3 = Array(3, 6, 7, 9, 11, 12, 13, 14, 15, 16, 17, 19, 21, 22, 23, 24, 26)
 
For q = 1 To 2
 
qq = Array3(q)
 
Worksheets(qq).Activate
 
For m = 1 To 10000
 
If Cells(m, 2).Value = "Owner" Then
i = i + 1
Array1(i) = m
End If
 
Next m
 
i = 0
 
For m = 1 To 10000
 
If Cells(m, 2).Value = "Other" Then
i = i + 1
Array2(i) = m
End If
 
Next m
 
i = 0
 
 
For y = 1 To 3 Step 2
For f = 1 To 20
Worksheets("Tools").Cells(f, y).Value = Array1(f)
Worksheets("Tools").Cells(f, y + 1).Value = Array2(f)
Next f
Next y
 
For i = 1 To 20
For k = Array1(i) To Array2(i)
 
On Error Resume Next
 
If Cells(k, 2).Value = "" Then
Cells(k, 2).Value = "qwerty"
End If
 
Next k
Next i
 
For m = 10000 To 1 Step -1
 
If Cells(m, 2).Value = "qwerty" Then
Cells(m, 2).EntireRow.Delete
End If
 
Next m
 
Next q
 
End Sub