Сохранение ссылок на переменные в книгах с помощью ActiveWorkbook

Question

Я пытаюсь получить постоянную ссылку на две конкретные книги, но, глядя в окно местных жителей, они не

Я также пытался ссылаться на ThisWorkbook.Name, но, похоже, это не решает проблему. Кажется, всегда возвращаются к ссылкам Workbook / ThisWorkbook.

Sub Import_data()

Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook

Set WB1 = ThisWorkbook

sFound = Dir(ActiveWorkbook.path & "\*Name.xlsx")    'the first one found
If sFound <> "" Then
    Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
    Set WB2 = ActiveWorkbook
End If

WB2.Worksheets("Sheet2").Range("A5").Copy _
WB1.Worksheets("Sheet2").Range("K18")


End Sub

Я получаю нижний индекс ошибки вне диапазона, когда я запускаю подпрограмму.

Answer 1

Попробуйте:

Sub Import_data()

Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook

Set WB1 = ActiveWorkbook

sFound = Dir(ActiveWorkbook.Path & "\*Name.xlsx")    'the first one found

If sFound <> "" Then

    Set WB2 = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & sFound)
    WB2.Worksheets("Sheet2").Range("A5").Copy
    WB1.Worksheets("Sheet2").Range("K18").PasteSpecial xlPasteValues

End If



End Sub

Answer 2

Если вы хотите чистый код: никогда не используйте ActiveWorkbook!

Попробуйте это:

Sub Import_data()

Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook

Set WB1 = ThisWorkbook

sFound = Dir(WB1.path & "\*Name.xlsx")    'the first one found

If sFound <> "" Then
    Set WB2 = Workbooks.Open(Filename:=WB1.path & "\" & sFound)
    WB2.Worksheets("Sheet2").Range("A5").Copy _
    WB1.Worksheets("Sheet2").Range("K18")
End If

End Sub

Answer 3

Изменить

Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
Set WB2 = ActiveWorkbook

на

Set WB2=Workbooks.Open(ActiveWorkbook.path & "\" & sFound)