Sub removeBlankRows()
    Application.ScreenUpdating = False
    Dim sh As Worksheet, lr As Long, i As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "Ñêë*" Then
            With sh
                'If Not Intersect(.Range("A5:A26"), .UsedRange) Is Nothing Then
                lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    q = 0
                    For Each cl In .Range("A5:A26").Cells
                        If cl.Value <> "" Then q = q + 1
                    Next cl
                If q > 0 Then
                    For i = lr To 5 Step -1
                        If .Cells(i, 1) = "" Then .Rows(i).Hidden = True
                    Next i
                    .PrintOut Copies:=1
                End If
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

lr = .Cells(Rows.Count, 1).End(xlUp).Row