Как подставить значение буфера обмена в функцию Cells.Find?

[Emirates]

Извиняюсь за вопрос от чайника, но всё-же ...

Мне нужно скопировать значение ячейки на одном листе, перейти на другой лист, запустить функцию поиска по листу со значением из буфера обмена.

Я запустил запись макроса, в принципе всё, как надо, НО: я вижу, что в коде, в качестве строки поиска, стоит строка из примера - email@email.com

Как сделать так, чтобы в качестве аргумента подставлялось значение из буфера обмена?

Кусок кода ниже:

ActiveCell.Offset(1, -7).Range("A1").Select
Selection.Copy
Sheets("database").Select
Range("A1").Select
Cells.Find(What:="email@emai.com", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

Заранее спасибо за ответы.

[doober]

Попробуйте так

On Error Resume Next

Dim O_Data As New DataObject
Dim Buffer
O_Data.GetFromClipboard
Buffer = O_Data.GetText(1)

[The_Prist]

А зачем из буфера? Может лучше сразу из ячейки брать? Я думаю, Вы копируете-то все равно значение из ячейки...

Cells.Find(What:=Range("A1").Value, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

Вместо Range("A1") свой адрес ячейки.
Можно брать из ячейки неполное значение:

Mid$(Range("A1"),2,2)

получится строка из 2-х букв, начиная со 2-й буквы значения ячейки А1.

[Hugo121]

doober забыл добавить, что для работы этой фишки надо подключить Microsoft Forms 2.0 Object Library

[Emirates]

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

doober забыл добавить, что для работы этой фишки надо подключить Microsoft Forms 2.0 Object Library

Боюсь уйти в офтопик, но - как подключить Microsoft Forms 2.0 Object Library?

На всякий случай - у меня стоит достаточно простая задача. Мне нужно в маленькую базу данных дописать номер сотрудника из большой (полной) базы данных. Задача разовая, так что, может нет смысла что-то дополнительное инсталлировать?

[Hugo121]

Подключить - самое простое: добавить в проект форму, а затем её удалить.
Но вообще я бы тоже не городил буфера и селекты - намного проще сделать типа так:

Sub tt()
x = ActiveCell.Offset(1, -7)
Sheets("database").Select
Sheets("database").Cells.Find(What: =x, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
End Sub

[Emirates]

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

Попробуйте так
Dim O_Data As New DataObject
Dim Buffer
O_Data.GetFromClipboard
Buffer = O_Data.GetText(1)[/CODE]

Попробовал сделать так, как написали:

Dim O_Data As New DataObject
Dim membermail As String

ActiveCell.Offset(1, -7).Range("A1").Select
O_Data.GetFromClipboard
membermail = O_Data.GetText(1)
Sheets("database").Select
Range("A1").Select
Cells.Find(What:=membermail, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

================

Но выполнение макроса обрывается ошибкой:

Compile error
User defined type not defined

[Emirates]

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

Но вообще я бы тоже не городил буфера и селекты - намного проще сделать типа так:

Спасибо огромное!

Заработала вот такая конструкция:

Sub abc()
x = ActiveCell.Offset(1, -7)
Sheets("database").Select
Sheets("database").Cells.Find(What: =x, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("update").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
End Sub

===============

Теперь только нужно организовать цикл (до тех пор, пока значение переменной x не будет равно "пусто") и дело в шляпе!

Пойду читать инструкцию ...

Ещё раз спасибо!

[Hugo121]

Честно пытася победить Ваш код с селектами - не вышло
Так зато работает, без всяких буферов:

Sub tttt()
x = ActiveCell.Offset(1, -7) 'хотя и здесь можно иначе сделать, без ActiveCell
Set y = Sheets("database").Cells.Find(What:=x, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False)
'и если уж так очень надо, в финале
Sheets("database").Select
y.Activate
End Sub

[Hugo121]

Что-то у Вас слишком сложно, я даже так сразу всю конструкцию не пойму... Наверняка можно проще и быстрее без селектов сделать...