|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
07.11.2012, 19:20 | #1 |
Регистрация: 05.07.2010
Сообщений: 6
|
Поиск значения по цвету и вставка в другую книгу
Здравствуйте уважаемые форумчане!
Помогите, пожалуйста. Пытаюсь сделать макрос по поиску ячеек в первом столбце "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 |
08.11.2012, 06:30 | #2 |
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
Можно так:
Код:
Чем шире угол зрения, тем он тупее.
Последний раз редактировалось SAS888; 08.11.2012 в 06:53. Причина: Добавлено |
08.11.2012, 08:11 | #3 |
Регистрация: 05.07.2010
Сообщений: 6
|
Спасибо огромное. Все заработало.
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Перенос/копирование макроса в другую книгу | Olper | Microsoft Office Excel | 7 | 21.12.2011 17:34 |
Копирование диаграмм в другую книгу | adiodas | Microsoft Office Excel | 0 | 21.03.2011 20:58 |
Как скопировать макросы в другую книгу? | alec | Microsoft Office Excel | 5 | 30.04.2010 08:13 |
Перемещение листа в другую книгу | GWolf | Microsoft Office Excel | 4 | 04.03.2009 14:53 |
Копирование листа в другую книгу макросом | xamillion | Microsoft Office Excel | 9 | 11.10.2008 08:59 |