Поиск части значения в одном из файлов

[bender11]

К сожалению под рукой нет самого кода.
Суть проблемы.
Есть код, который открывает 2 файла. 1 файл - шаблон, 2-файл с данными.
Код должен искать в файле данных во 2 столбце, строки с 15 по 60, ячейки, которые содеражат часть текста - "контр".
Если ячейка содержит такой текст, то в эту же строку, в которой найдена ячейка, но в столбцы 23,24,25 копируются 3 ячейки из шаблона (они всегда одинаковы).

Проблема в том, что поиск ячеек и копирование информации происходит не в тот файл.

скрит примеерно такого плана:
set shablon=openworkbook.....
set wbsrc=openworkbook.....
for k=15 to 60
if not Range(cells(k,2);cells(k,2)).find(" контр",,,xlpart) is nothing
then
shablon.worksheet("рус").range("r13 :t13").copy
activeworksheet.range.(cells(k,2);c ells(k,2)).paste
endif
next

С таким кодом все действия производятся с книгой, в которой находится макрос, а не с нужным файлом.
Как это испарвить?

[Watcher_1]

Замените
activeworksheet.range.(cells(k,2);c ells(k,2)).paste
На
wbsrc.range.(cells(k,2);c ells(k,2)).paste

[bender11]

Сообщение от Watcher_1

Замените
activeworksheet.range.(cells(k,2);c ells(k,2)).paste
На
wbsrc.range.(cells(k,2);c ells(k,2)).paste

Это вторя проблема, завтра еще раз проверю, но, по-моему, я такой вариант уже пробовал, вба ввыдает ошибку.

А как сделать чтобы поиск шел по нужной мне книге, а не по той из котрой запущен макрос?

[Watcher_1]

Сообщение от bender11

Это вторя проблема, завтра еще раз проверю, но, по-моему, я такой вариант уже пробовал, вба ввыдает ошибку.

А как сделать чтобы поиск шел по нужной мне книге, а не по той из котрой запущен макрос?

Тогда надо так
wbsrc.sheets(1).range.(cells(k,2);c ells(k,2)).paste

Где индекс Sheets(1) меняете на номер листа где ищете

[nilem]

Может, как-то так?

.....
'set shablon=openworkbook.....
'set wbsrc=openworkbook.....
Dim CopyRng As Range
Set CopyRng = shablon.Worksheet("рус").[r13:t13]
With wbsrc.Sheets(1)
    For k = 15 To 60
        If .Cells(k, 2) Like "*контр*" Then
            CopyRng.Copy .Cells(k, 23)
        End If
    Next
End With
.....

[bender11]

Сообщение от nilem

Может, как-то так?

.....
'set shablon=openworkbook.....
'set wbsrc=openworkbook.....
Dim CopyRng As Range
Set CopyRng = shablon.Worksheet("рус").[r13:t13]
With wbsrc.Sheets(1)
    For k = 15 To 60
        If .Cells(k, 2) Like "*контр*" Then
            CopyRng.Copy .Cells(k, 23)
        End If
    Next
End With
.....

Попробую завтра таким пойти таким путем.

А можно как-то исправить ситуацию в исходном коде, например, используя activate?

[Watcher_1]

Сообщение от bender11

Попробую завтра таким пойти таким путем.

А можно как-то исправить ситуацию в исходном коде, например, используя activate?

Можно

set shablon=openworkbook.....
set wbsrc=openworkbook.....
for k=15 to 60
if not Range(cells(k,2);cells(k,2)).find(" контр",,,xlpart) is nothing
then
shablon.worksheet("рус").range("r13 :t13").copy
wbsrc.Activate
activeworksheet.range.(cells(k,2);c ells(k,2)).paste
endif
next