Excel VBA Макрос: Закрасить всю строку в цвет ячейки из первого столбца.

[alexandr_rus]

Здравствуйте.

В первом столбце расположены ячейки с настроенным цветом фона. Диапазон "A3:A7" и "A15:A21"
Я хочу при помощи макроса закрасить всю строку в фон ячейки первого столбца.

Цвета в первом столбце расположены произвольно.

Через команду print activecell.Interior.Color
узнал номера цветов в первом столбце:
6299648
8092539
13998939
10921638
5395026

При запуске (макроса) вся строка в указанном диапазоне закраситься в цвет ячейки из первого столбца "6299648".
Следующая строка закрасится в цвет "8092539" и т.д.

[Администратор]

Макрос

Sub макрос()

    '1. Отключение монитора, чтобы ускорить макрос и чтобы не мерцало.
    Application.ScreenUpdating = False
   
    '2. Закраска.
    color Range("A3:A7")
    color Range("A15:A21")
   
    '3. Вкл. монитора.
    Application.ScreenUpdating = True

End Sub

Private Sub color(rng As Range)

    Dim cell As Range
   
    ' Цикл по ячейкам.
    For Each cell In rng.Cells
        ' Закраска.
        cell.EntireRow.Interior.color = cell.Interior.color
    Next cell

End Sub

[свернуть]

[alexandr_rus]

Большое Вам - Спасибо!!!
Вот попробовал применить макрос ко всем страницам....
Код:

Спойлер

Sub color_all_sheets()
Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets


    '1. ?????????? ????????, ????? ???????? ?????? ? ????? ?? ???????.
    Application.ScreenUpdating = False
 
    '2. ????????.
    color ws.Range("A1:A3000")
   
    '3. ???. ????????.
    Application.ScreenUpdating = True
Next

End Sub

Private Sub color(rng As Range)
    Dim cell As Range
   
    ' ???? ?? ???????.
    For Each cell In rng.Cells
        ' ????????.
        cell.EntireRow.Interior.color = cell.Interior.color
    Next cell

End Sub

[свернуть]

[Администратор]

Перед копированием кода, переключайте язык у клавиатуры на русский, чтобы не искажался русский текст.

[Администратор]

Сейчас у вас выключается и включается монитор при работе с каждым листом. В этом нет необходимости. Достаточно выключать и включать монитор один раз:

Макрос

Sub color_all_sheets()

    Dim ws As Worksheet
   
    '1. ?????????? ????????, ????? ???????? ?????? ? ????? ?? ???????.
    Application.ScreenUpdating = False
 
    ' Цикл по листам.
    For Each ws In ActiveWorkbook.Worksheets
        '2. ????????.
        color ws.Range("A1:A3000")
    Next
   
    '3. ???. ????????.
    Application.ScreenUpdating = True

End Sub

Private Sub color(rng As Range)
    Dim cell As Range
    ' ???? ?? ???????.
    For Each cell In rng.Cells
        ' ????????.
        cell.EntireRow.Interior.color = cell.Interior.color
    Next cell
End Sub

[свернуть]