Макрос:копирование по определенным условиям

[MarieGu]

Дорогие, пожалуйста помогите в решении проблемы с макросом. У меня огромная таблица с данными. Во вложении пример. Мне надо написать макрос:
скопировать данные из ячейки D15 в ячейки C5:C15, и так далее из ячейки D24 в ячейки C16:C24. При этом ячейки D15, D24 надо обнаружить по цвету.

Заранее большое спасибо

[Hugo121]

Sub tt()
    Dim x&, y&, cc As Range
    x = 5
    For Each cc In [d5:d24]
        If cc.Interior.ColorIndex = 8 Then
            y = cc.Row
            Range(Cells(x, 3), Cells(y, 3)) = cc.Value
            x = y + 1
        End If
    Next
End Sub

Осталось недоделано - вероятно область [d524] нужно определять динамически.
В примере это можно сделать и с помощью currentregion, и стандартно
iLastRow = Cells(Rows.Count, 4).End(xlUp).Row
Как лучше - это нужно смотреть реальный файл.

P.S. Например так:

Sub ttt()
    Dim x&, y&, cc As Range
    x = 5
    For Each cc In [d5].CurrentRegion.Columns(2).Cells
        If cc.Interior.ColorIndex = 8 Then
            y = cc.Row
            Range(Cells(x, 3), Cells(y, 3)) = cc.Value
            x = y + 1
        End If
    Next
End Sub

[Казанский]

На скорую руку, убегать пора:

Sub MarieGu()
Dim c As Range, d As Range
Set c = Cells(Rows.Count, "D").End(xlUp)
Set d = c
On Error Resume Next
Do
    Set c = c(0)
    If Err Then Exit Sub
    If c.Interior.ColorIndex > 0 Then 'окрашенная ячейка
        Range(d, c(2)).Offset(, -1) = d
        Set d = c
    End If
Loop
End Sub

[MarieGu]

Уважаемые, ОГРОМНОЕ ВАМ СПАСИБО!!!