перенос данных

[Viento]

Добрый вечер!
Помогите плз, решить следующую задачу при помощи макроса.

Необходимо из файла "данные.xls" распределить результаты колонок "Прослушка" и "Тест" в соответсвующие колонки согласно фамилиям в файле "Контроль по бонусам.xls"

Премного благодарен!

[viter.alex]

Заготовки есть, а как должен выглядеть результат? Приложи.

[Viento]

Повторно отправляю архив с файлами с вписанными исходными данными.

[Viento]

Результат это колонки "прослушка и тест" они должны переместиться в файл "контроль по бонусам" в соответствии с фамилиями.

[tolikman]

положи файл в одну папку с файлом "данные.xls", или открой этот файл откуда угодно. потом запусти то, что вложено.
при открытии запускается макрос, который ищет среди открытых книгу "данные.xls", если не находит то открывает. ищет совпадения фамилий и копирует нужное при найденных совпадениях.

[Viento]

а можно чтобы не при открытии файла он начинал работать а запускался в ручную?

[viter.alex]

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

а можно чтобы не при открытии файла он начинал работать а запускался в ручную?

Да не вопрос. Убери из модуля «ЭтаКнига» эту процедуру, или закомментируй ее, чтобы не жалеть. А вдруг пригодится?

Private Sub WorkBook_Open()
    modul.getData
End Sub

[Viento]

Покажи плз где именно? Я не въезжаю.

Sub getData()
Dim dataFile As String
Dim book As Workbook
Dim sht As Worksheet, curSht As Worksheet
Dim rng As Range, findedRng As Range
Dim i As Long, a As Long
Dim test As Boolean
test = True
For i = 1 To Workbooks.Count
If Workbooks(i).Name = "данные.xls" Then test = False
Exit For
Next i
dataFile = ThisWorkbook.Path & "\" & "данные.xls"
If test Then Set book = Workbooks.Open(dataFile) Else Set book = Workbooks(i)
Set sht = book.Sheets("1 смена")
Set curSht = ThisWorkbook.Sheets("1 смена")
i = 3
Do While curSht.Cells(i, 2) <> Empty
i = i + 1
Loop
i = i - 1
If i = 2 Then Exit Sub
Set rng = curSht.Range("B2:B" & i)
i = 3
Do While sht.Cells(i, 2) <> Empty
Set findedRng = rng.Find(sht.Cells(i, 2))
If Not findedRng Is Nothing Then
a = findedRng.Row
curSht.Cells(a, 7) = sht.Cells(i, 3)
curSht.Cells(a, 8) = sht.Cells(i, 4)
End If
Set findedRng = Nothing
i = i + 1
Loop
End Sub

[viter.alex]

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

Покажи плз где именно? Я не въезжаю.…

Здесь.

[tolikman]

хм, у viter.alex по лучше будет..))
внимательно смотри интерфейс редактора VBA: слева, над модулями, показаны листы книги и сама книга (см untitled.JPG), выбери книгу и проанализируй.