Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Integer
j = Target.Column
Dim i As Integer
i = Target.Row
Dim k
Dim di
Dim fn As String
di = ThisWorkbook.Sheets("Данные").Cells(2, 1)
If j = 3 Then
k = Cells(i, 2)
fn = Dir(di & k & ".xlsx")
If fn = k & ".xlsx" Then
Range("D1:AS1").Select // В этом диапазонне ссылки на ячейки файла-бланка
Selection.Copy
Cells(i, 4).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Rows(i).Replace what:="000001", Replacement:=k
Rows(i).EntireRow.AutoFit
Cells(i, 3).Select
Cells(i, 3).Activate
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
di & k & ".xlsx"
Else
MsgBox "такого номера нет в бланках"
Exit Sub
End If
End If
End Sub
Макрос служит для добавления по одной строчке бланков, которые находятся в папке, их номера 000001...n, при выделении двух последних ячеек в столбце C и их протяжки на 1 ячейку, создается ссылка на файл и заполняется строка из ячеек этого файла. Постоянно приходится добавлять по одной строке. хотелось бы чтоб протягивался до последнего номера файла в папке по нажатию кнопки. Помогите, подскажите, сам макросы писал только по записи