Поиск ячейки по цвету

Sub work()
 
Dim b As Range
 
    Dim столбец As Integer ' номер столбца
    Dim строка As Integer ' номер строки
    столбец = 1
    строка = 9
    
Range("I9").Select ' выбираем 1ю ячейку с данными
 
' Считаем количество непустых ячеек в строке
 
    Dim a As Boolean
    Dim i As Integer
    Dim j As Integer ' переменная для подсчета количества добавляемых строк
    Dim k As Integer ' переменная для подсчета строк
    Dim d As Double
    Dim c As Range
    
    k = 9
    j = 0
    i = 1
    a = True
    Set c = Range(ActiveCell.Address)
    c.Select
    d = c.Value
    c.Value = d
    While (a = True)
        ActiveCell.Offset(0, 1).Select
        If (IsEmpty(ActiveCell.Value) = False) Then
            Set c = Range(ActiveCell.Address)
            i = i + 1
            c.Select
            d = c.Value
            c.Value = d
        Else
            a = False
        End If
    Wend
    
    MsgBox i
' Считаем количество добавляемых строк
 
j = i / 3 - 1
 
' Добавляем нужное количество строк
 
While (j <> 0)
    Rows(k + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    j = j - 1
Wend
 
' Перемещаем данные
 
j = i / 3 - 2
Dim пс As Integer ' проверка строки
пс = строка
Columns("I:N").Select ' Выделяем рабочие столбцы
Set b = Selection
' координаты для сдвига активной ячейки
Dim x As Integer
Dim y As Integer
y = 0
x = 2
строка = строка + 1
Range("I9").Select
While (j <> 0)
        ActiveCell.Offset(y, x).Select
            Set c = Range(ActiveCell.Address)
            c.Select
            MsgBox "Выбрано значение"
            Selection.Cut
            b(строка, столбец).Select
            ActiveSheet.Paste
            
            If (столбец = 1) Then
            x = x + 1
            Else
            x = x - 1
            End If
            
            
            
            If (пс = строка) Then
                строка = строка + 1
                столбец = столбец - 1
                x = x + 1
            Else
                
                y = y - 1
                пс = пс + 1
                столбец = столбец + 1
            End If
                
            j = j - 1
                        
        Wend
 
MsgBox "Работа выполнена."
 
End Sub

Sub tp() 'tp - подстанция (я так думаю) не путать с чем другим
    Dim a(), b()
    Dim i%, ii%, x%, part1%, part2%
    With Sheets("Лист1") 'с листом лист1
        a = .UsedRange.Value 'берём в массив рабочий диапазон (как ctr+shift+end)
    End With
    ReDim b(1 To 10000, 1 To 14) 'перезаписываем массив b() на 10000 строк например
    ii = 1 'счётчик строк массива b()
    For i = 2 To UBound(a) 'проходим по массиву а() - "строки"
        For j = 1 To 7 'идём по "колонкам" первые 7 элементов
            b(ii, j) = a(i, j) 'пишем в массив b()
        Next
        'считаем кол-во ячеек на строку начиная с 9й колонки
        x = 0 'сбрасываем счётчик кол-ва ячеек
        For j = 9 To UBound(a) 'идём по колонкам с 9 и до конца массива
            If a(i, j) = "" Then Exit For 'если дошли до пусто то выходим из цикла
            x = x + 1 'если не пусто увеличиваем счётчик на ед
        Next
        part1 = x / 3 'границы для жёлтого
        part2 = part1 * 2 'граница для красного
        If x <> 0 Then 'если была загрузка то
            For j = 9 To 9 + part1 - 1 Step 2 'идём по строке с 9 по 14 колонку с шагом 2
                'пишем в массив b()
                b(ii, 9) = a(i, j) 'жёлтый
                b(ii, 10) = a(i, j + 1) 'жёлтый + 1
                b(ii, 11) = a(i, j + part1) 'зелёный
                b(ii, 12) = a(i, j + part1 + 1) 'зелёный + 1
                b(ii, 13) = a(i, j + part2) 'красный
                b(ii, 14) = a(i, j + part2 + 1) 'красный + 1
                ii = ii + 1 'увеличиваем счётчик строк массива b()
            Next
        'если загрузки нет 0%
        Else: ii = ii + 1 'увеличиваем счётчик строк массива b()
        End If
    Next
    'выгружаем массив b() на лист 2
    Sheets("Лист2").Cells(2, 1).Resize(UBound(b), 14) = b
End Sub

For j = 9 To UBound(a, 2) 'идём по колонкам с 9 и до конца массива