¿Cómo simplificar este código para que no tarde mucho en ejecutarse la macro?

Dim NoFilas As Integer

NoFilas = Application.WorksheetFunction.CountIf(Range("A4:A1000"), "<>")

Dim fila As Integer
Dim columna As Byte
fila = 4
columna = 27

While fila < NoFilas + 4
If columna < 46 Then
Hoja2.Select
NoGlasses = Application.WorksheetFunction.CountIf(Range(Cells(fila, 1), Cells(fila, 26)), (Cells(3, columna)))
Cells(fila, columna).Value = NoGlasses
columna = columna + 1
Else
columna = 27
fila = fila + 1
End If
Wend
End Sub