Помогите склеить два макроса. Задача такая. Необходимо найти значение в закрытой Книге на Листе1 и скопировать в другую книгу(с которой и будет запускаться макрос). ПРОБЛЕМА : количество строк на листе меняется т.е не фиксированный и искомые значения могут менять свой адрес, но заголовки остаются перед этими значениями. Можно привязаться к определенным заголовкам, что и сделано в первом макросе. НО он не универсальный. Нужно, чтобы он брал местонахождение фа1ла, название Книги и Листа с ОПРЕДЕЛЕННЫХ ЯЧЕЕК (например эти ячейки будут фиксируется в книги куда копируются значения в ячейках B4 и B5, как во втором макросе)
Первый макрос [vba]
Code
Sub Первый_Макрос()
Set c = Workbooks("Книга1.xlsm").Worksheets("Лист1").Range("A300:K100000").Find("Товар:", LookIn:=xlValues)
If Not c Is Nothing Then Application.Goto c, True Workbooks("Книга2.xlsm").Worksheets("Лист1").Cells(1, 1) = Cells(ActiveCell.Row + 5, ActiveCell.Column)
End If End Sub
[/vba]
Второй Макрос ' Основная функция GetValue ' Аргументы: ' p - местонахождение фаила, фиксируется в ячейках B4 и B5 ' f - имя фаила в формате name.xlsx ' s - наименование листа, список используемых листов находится в ячейках G5:G9 ' r - массив, в котором находятся необходимые данные
[vba]
Code
Function GetValue(path, file, sheet, ref) Dim arg As String If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "File Not Found" Exit Function End If arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function
Sub Второй_макрос() p = Range("B4").Value f = Range("B6").Value S = Range("G7").Value Application.ScreenUpdating = False For r = 33 To 33 For c = 2 To 2 a = Cells(r - 19, c + 4).Address Cells(r, c) = GetValue(p, f, S, a) Next c Next r Application.ScreenUpdating = True
End Sub
[/vba]
Помогите склеить два макроса. Задача такая. Необходимо найти значение в закрытой Книге на Листе1 и скопировать в другую книгу(с которой и будет запускаться макрос). ПРОБЛЕМА : количество строк на листе меняется т.е не фиксированный и искомые значения могут менять свой адрес, но заголовки остаются перед этими значениями. Можно привязаться к определенным заголовкам, что и сделано в первом макросе. НО он не универсальный. Нужно, чтобы он брал местонахождение фа1ла, название Книги и Листа с ОПРЕДЕЛЕННЫХ ЯЧЕЕК (например эти ячейки будут фиксируется в книги куда копируются значения в ячейках B4 и B5, как во втором макросе)
Первый макрос [vba]
Code
Sub Первый_Макрос()
Set c = Workbooks("Книга1.xlsm").Worksheets("Лист1").Range("A300:K100000").Find("Товар:", LookIn:=xlValues)
If Not c Is Nothing Then Application.Goto c, True Workbooks("Книга2.xlsm").Worksheets("Лист1").Cells(1, 1) = Cells(ActiveCell.Row + 5, ActiveCell.Column)
End If End Sub
[/vba]
Второй Макрос ' Основная функция GetValue ' Аргументы: ' p - местонахождение фаила, фиксируется в ячейках B4 и B5 ' f - имя фаила в формате name.xlsx ' s - наименование листа, список используемых листов находится в ячейках G5:G9 ' r - массив, в котором находятся необходимые данные
[vba]
Code
Function GetValue(path, file, sheet, ref) Dim arg As String If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "File Not Found" Exit Function End If arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function
Sub Второй_макрос() p = Range("B4").Value f = Range("B6").Value S = Range("G7").Value Application.ScreenUpdating = False For r = 33 To 33 For c = 2 To 2 a = Cells(r - 19, c + 4).Address Cells(r, c) = GetValue(p, f, S, a) Next c Next r Application.ScreenUpdating = True