касательно копирования формата строк

[Volodymyr]

спасибо за помощь, Все работает как хотел.

Володя.

[Volodymyr]

есть еще 1 вопрос:
я запусил Ваш макрос на таблице с 12000 строками, на что макрос выдал ошибку в строке:
Intersect(cell.EntireRow, sh.Range("a:ad")).Interior.ColorInd ex = Index
Ошибка:
Run-time error 9.
С чем она может быт связана?

[Volodymyr]

все, нашел ошибку сам. Я пытался записать цвет через RGB(153, 153, 255), а он начал ругаться.

[Volodymyr]

Увжаемые фомчне,
а как в предложенный вариант макроса записать цвет в RGB?
на запись:
Case "Фирма1": Index = RGB(0, 0, 255)
появляется ошибка Run-time error 9?

[SAS888]

Вместо, например,

[A1].Interior.ColorIndex = 3

используйте

[A1].Interior.Color = RGB(255, 0, 0)

[EducatedFool]

В таком виде всё работает без ошибок:

Sub Main()
    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveSheet: Dim cell As Range
    sh.UsedRange.Offset(1).Interior.ColorIndex = 0    ' очистка цвета
    Dim ra As Range: Set ra = Intersect(sh.UsedRange.Offset(1), sh.Columns("AD"))
    For Each cell In ra.Cells
        Select Case Trim(cell.Value)
            Case "Фирма1": Index = RGB(223, 5, 255)
            Case "Фирма2": Index = RGB(223, 5, 107)
            Case "Фирма3": Index = RGB(223, 95, 57)
            Case "Фирма4": Index = RGB(223, 195, 7)
            Case "Фирма5": Index = RGB(223, 55, 97)
            Case "Фирма6": Index = RGB(223, 105, 7)
            Case "Фирма7": Index = RGB(223, 155, 97)
            Case Else: Index = RGB(255, 255, 200)
        End Select
        Intersect(cell.EntireRow, sh.Range("a:ad")).Interior.Color = Index
    Next
End Sub

[Volodymyr]

все работает,
Спасибо большое.

[SAS888]

Вы не внимательны.
Не

.Interior.ColorIndex = Index

, а

.Interior.Color = Index

[EducatedFool]

В предыдущих 2 сообщениях Вам уже указали на ошибку:

Напишите
Intersect(cell.EntireRow, sh.Range("a:ad")).Interior.Color = Index

вместо

Intersect(cell.EntireRow, sh.Range("A:BF")).Interior.ColorIndex = Index