Макрос VBA для изменения цвета ячейки нескольких листов

Question

Я получил этот макрос, который проверяет все листы в массиве и окрашивает диапазон M8, в котором есть значения. Это работает, но останавливается после 38 ячеек и не окрашивает никакие ячейки.

Может кто-нибудь взглянуть и посоветовать, где что-то не так.

Заранее спасибо

Sub TestColour2()
Dim st As Sheets
Dim x As Integer
Dim wsh As Worksheet

Sheets(Array("T1", "E2", "S3", "M4", "S5", "F5")).Select

    For Each wsh In ActiveWindow.SelectedSheets
        Application.ScreenUpdating = False
       'st.Select
        NumRows = Range("M8", Range("M8").End(xlDown)).Rows.Count
        Range("M8").Select

        For x = 1 To NumRows
            ActiveCell.Interior.ColorIndex = 35
            ActiveCell.Offset(1, 0).Select
        Next x
    Next wsh
Application.ScreenUpdating = True
End Sub

Answer 1

Ниже приведен более эффективный и надежный макрос, который даст тот же результат и будет работать намного быстрее:

Обновлен в соответствии с рекомендациями CLR, закрасьте диапазон сразу, а не другим циклом.

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("M" & Rows.Count).End(xlUp).Row

        .Range("M8:M" & numrows).Interior.ColorIndex = 35
    End With
    Next

End Sub

Однако, если нужно закрасить только заполненные ячейки, мой первоначальный ответ остается в силе:

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("M" & Rows.Count).End(xlUp).Row

        For Each cel In .Range("M8:M" & numrows)
            If cel.value = "" then cel.Interior.ColorIndex = 35
        Next cel
    End With
    Next

End Sub

В качестве альтернативы это можно сделать с помощью фильтра, если диапазон слишком велик для циклического прохождения:

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("H" & Rows.Count).End(xlUp).Row
    Debug.Print numrows & Sheets(sheetz(x)).Name


        .Range("H8:H" & numrows).AutoFilter field:="1", Criteria1:="<>"
        .Range("H8:H" & numrows).Rows.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 35
        .AutoFilterMode = False
        End With
    Next

End Sub