Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск заданного значения в каждом листе, с последующим копированием листа в новую книгу
 
#1
21.02.2013 17:04:36
Добрый день!

Пишу макрос, хочу чтобы он проверял значение ячейки K1 каждого листа каждой открытой книги, и если находит заданное значение в ячейке K1, то этот лист копируется в новую книгу.

ниже код и что-то безрезультатно. прошу помощи

Код
Sub FindKeyWord()

Dim book As Object  'переменная книги 
Dim h As Variant  'переменная листа
Dim bkOtchet As Excel.Workbook
Dim bkNew As Excel.Workbook


Workbooks.Add 'создаю новую книгу
Set bkNew = ActiveWorkbook   'присваиваю ей переменную bkNew 


For Each book In Workbooks 'проверяю каждую открытую книгу
    For h = 1 To Sheets.Count   'определяю кол-во листов в книге   
        Worksheets(h).Activate   'проверяю каждый лист в книге   
     
        If Cells(1, 11) Like "*KEY_WORD*" Then   'ищу в ячейке K1 значение KEY_WORD
            Sheets(h).Move Before:=Workbooks(bkNew).Sheets(1)      'пытаюсь скопировать лист в котором была найдена ячейка K1 с идентичным значением в созданную книгу bkNew перед 1ым листом
            Workbooks(bkNew).Sheets(1).Range("K1").FormulaR1C1 = "PAPI"  'переименовываю значение ячейки K1 чтобы не вызвать циклического повторения операции
        End If
    Next h
Next
End Sub
Изменено: caustic - 24.02.2013 23:29:13
caustic
 
 
 
#2
21.02.2013 17:09:09
Код
For h = 1 To Sheets.Count   'определяю кол-во листов в книге  

вы будете смеяться - но эта строка будет перебирать листы в активной книге, а вовсе не там, где вы хотели.
правильно так:
Код
For h = 1 To book.Sheets.Count   'определяю кол-во листов в книге  


ну и во всём остальном коде - аналогично.
указывайте Экселю конкретно - что и где вы ищете.
откуда копируете, куда вставляете.
Изменено: ikki - 21.02.2013 17:09:43
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#3
21.02.2013 17:49:44
К тому же вот так писать тоже не следует Workbooks(bkNew) Вы ведь раньше уже объявили Dim bkNew As Excel.Workbook

В итоге код должен выглядить примерно так:
Код
Sub FindKeyWord()

Dim book As Excel.Workbook  'переменная книги
Dim h As Byte '(листов в одной книге больше чем 255 вроде быть не может) / но можно заменить на integer если у Вас все же встречаются
'Dim bkOtchet As Excel.Workbook 'в Вашем коде ни где не используется, можно удалить
Dim bkNew As Excel.Workbook

On Error Resume Next
For Each book In Workbooks 'проверяем каждую книгу
    For h = 1 To book.Sheets.Count  'определяем кол-во листов в книге и последовательно перебираем
        'If book.Sheets(h).Cells(1, 11) Like "*KEY_WORD*" Then   'ищу в ячейку K1 значение KEY_WORD
            'на случай если нужных значений в листах найдено не будет, новую книгу создаем только после нахождение первого значения
            If bkNew Is Nothing Then 'проверяем что новая книга не существует
                Set bkNew = Workbooks.Add 'добавляем новую книгу и запоминаем ее
            End If
            book.Sheets(h).Move Before:=Workbooks(bkNew).Sheets(1)      'копируем лист в котором была найдена ячейка K1 с идентичным значением в созданную книгу bkNew перед 1ый листом
            bkNew.Sheets(1).Range("K1").FormulaR1C1 = "PAPI"  'переименовываю значение ячейки K1 чтобы не вызвать циклического повторения опереации
        'End If
    Next h
Next

End Sub
Изменено: SkyShark - 21.02.2013 17:56:55
 
 
 
#4
21.02.2013 18:07:24
Цитата
SkyShark пишет:
(листов в одной книге больше чем 255 вроде быть не может)
может.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#5
21.02.2013 18:24:11
Цитата
caustic пишет:
Добрый день!

Пишу макрос...

И я вам писал в прошлых темах, но отклика так и не получил
Как-то это входит у вас в привычку
 
 
 
#6
21.02.2013 18:30:25
Цитата
Kuzmich пишет:
И я вам писал в прошлых темах, но отклика так и не получил
Заведите свой "чёрный список" и таким гостям больше не помогайте.
 
 
 
#7
22.02.2013 10:12:54
Kuzmich, извините, я возможно не видел ваших сообщений.
я обычно всем отвечаю, тем более когда люди мне оказывают помощь.
caustic
 
 
 
#8
22.02.2013 10:23:42
SkyShark, спасибо вам, но макрос так же как и у меня не переносит вкладку с найденным значением "KEY_WORD" в новую книгу, а просто присваивает ячейке K1 значение "PAPI"

а подразумевалось другое: он будет искать лист со значением KEY_WORD в ячейке K1 в каждом листе, каждой открытой книги, и в случае нахождения, этот лист перемещался/копировался в новую книгу.
caustic
 
 
 
#9
22.02.2013 13:24:40
Цитата
caustic пишет:
 я возможно не видел ваших сообщений.

Так посмотрите по форуму:
Темы
Удаление строк по цвету
Объединение диапазонов ячеек с одинаковыми значениями
Проверка значений ячеек по уникальному номеру
 
 
 
#10
22.02.2013 14:56:18
Kuzmich, извините пожалуйста, я плюсовал ваши ответы, я думал это и есть "сказать спасибо"
caustic
 
 
 
#11
22.02.2013 15:26:08
Так подошли вам макросы в тех сообщениях?
 
 
 
#12
22.02.2013 18:31:35
Kuzmich,  все как один. еще раз огромное вам спасибо, вы меня действительно очень выручили. ;)
caustic
 
 
 
#13
22.02.2013 18:51:32
Удачи Вам в работе
 
 
 
Страницы: 1
Наверх