Поиск значения по цвету и вставка в другую книгу

[rus33]

Здравствуйте уважаемые форумчане!
Помогите, пожалуйста.
Пытаюсь сделать макрос по поиску ячеек в первом столбце "A" (условие: заливка каким нибудь цветом) и копирования строки с этой ячейкой и соседними ячеиками в таблицу в другой книге в которой и производим сбор данных. Закрашенных ячеек может быть до 10 штук в интервале от 22 до 400 строки, столбца А. Получился следующий код. Код работает но как обычно не доконца. Поиск начинается с 22 строки и идет в низ согласно задумки, доходит до первой желтой ячейки и копирует нужные мне данные, после этого продолжается поиск но почемуто следующую желутую ячекику макрос уже не видит. Так же не доконца уверен что вслучаче, если код увидит вторую закрашенную ячейку, то значения вставивит за уже занятой строкой. Помогите пожалуйста.

Sub Collor12()

Dim i As Range
Dim x As Range
Dim iLastRow As Long
Dim wkb1 As Workbook
Dim wkb2 As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("Summury").Select
Range(Cells(2, 24), Cells(2, 36)).ClearContents
iLastRow = 1

Set wkb1 = ActiveWorkbook
strFile = Application.GetOpenFilename
If strFile = "False" Then Exit Sub

With Workbooks.Open(strFile)
For i = 22 To 400
Set x = Cells(i, "A")
If x.Interior.ColorIndex > 0 Then 'adjust to match your number
Range(Cells(i, 1), Cells(i, 14)).Copy
wkb1.Sheets("Summury").Activate
wkb1.Sheets("Summury").Range(Cells( iLastRow + 1, 24), Cells(iLastRow + 1, 36)).Select
ActiveSheet.Paste
iLastRow = iLastRow + 1
End If
Next i

End With

Workbooks.Open strFile
Set wkb2 = ActiveWorkbook

wkb1.Sheets("Input").Activate
wkb2.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

End Sub

[SAS888]

Можно так:

Sub Collor12()
    Dim i As Long, x As Range, ws As Worksheet, strFile As String
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set ws = ThisWorkbook.Sheets("Summury"): ws.[X:AJ].Clear
    strFile = Application.GetOpenFilename
    If strFile = "False" Then Exit Sub
    Workbooks.Open (strFile)
    For i = 22 To 400
        If Cells(i, 1).Interior.ColorIndex <> xlNone Then _
        If x Is Nothing Then Set x = Cells(i, 1) Else Set x = Union(x, Cells(i, 1))
    Next
    If Not x Is Nothing Then Intersect(x.EntireRow, [A:N]).Copy ws.[X2]
    ActiveWorkbook.Close False
End Sub

ПРИМЕЧАНИЕ: Если подразумевается работа в Excel 2007 (и выше), и если цвет заливки ячеек заранее известен, то данную задачу можно решить, используя "фильтр по цвету".

[rus33]

Спасибо огромное. Все заработало.