Здравствуйте, помогите разобраться. Есть две книги 1(основная) и 2. Надо во 2 книге найти какое - то слово, которое есть в книге 1, выделить его,сдвинуться на определенное количество ячеек в сторону(сдвиг должен указывать сам пользователь) после чего скопировать это значение и перенести его в первую книгу тоже со сдвигом (офсетом) который задается пользователем. Мой макрос в общую (1 книгу) вставляет правильно, но копирует не правильно, он копирует (во второй книге) по адресу ячейки которая находиться в общей(1) книге. Например если имя "Иван" в 1 книге находиться по адресу А1, а во второй книге по адресу А1 будет "Костя", а "Иван" будет по адресу А46, он мне скопирует "Костя" и вставит в 1 книгу в А1. Помогите допилить его, что бы правильно копировалось.Тоесть я хочу, что бы можно было копировать любую информацию, но что бы офсет запрашивался у пользователя, а не редактировать через код. Постарался максимально понятно объяснить задумку.
| Код |
|---|
Sub Копирование()
Dim Searching As Range
File = Application.GetOpenFilename _
("Книга что ищем и куда потом копируем (*.xls*),*.xls*", False)
Workbooks.Open File
Firstbook = ActiveWorkbook.Name ' присваивает переменной книгу из которой берем
Set Firstcopy = Application.InputBox("Укажите ЧТО искать:", "Запрос данных", Selection.Address, Type:=8)
Set Firstpaste = Application.InputBox("Укажите куда вставлять результат, только одну ячейку:", Selection.Address, Type:=8)
File2 = Application.GetOpenFilename _
("Книга откуда копируем значение (*.xls*),*.xls*", False)
Workbooks.Open File2
Secondbook = ActiveWorkbook.Name
Set Secondcopy = Application.InputBox("Укажите ЧТО искать ВСЕ :", "Запрос данных", Selection.Address, Type:=8)
Set Secondpaste = Application.InputBox("Ячейка с первым копируемым значением, только одна:", Selection.Address, Type:=8)
For k = 1 To 65
Windows(Secondbook).Activate
Set Searching = Secondcopy.Find(What:=Firstcopy(k), MatchCase:=True, LookAt:=xlWhole)
If Searching Is Nothing Then
Else:
Secondpaste.Select
ActiveCell.Offset(k - 1).Copy ' сдвиг для копирования. Берет номер ячейки с первого файла, копирует не правильно.
Windows(Firstbook).Activate
Set Searching = Firstcopy.Find(What:=Firstcopy(k), MatchCase:=True, LookAt:=xlWhole)
Firstpaste.Select ' сдвиг для вставки
ActiveCell.Offset(k - 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False ' сдвиг для вставки. Вставка работает правильно, с нее берется копирование.
End If
Windows(Secondbook).Activate
Next k
End Sub
|
Изменено: - 06.10.2018 18:02:18
