Выбор другой открытой книги для получения данных

Sub ПримерИспользования_GetAnotherWorkbook()
    Dim WB As Workbook
    Set WB = GetAnotherWorkbook
    If Not WB Is Nothing Then
        MsgBox "Выбрана книга: " & WB.FullName, vbInformation
    Else
        MsgBox "Книга не выбрана", vbCritical: Exit Sub
    End If
    ' обработка данных из выбранной книги
    x = WB.Worksheets(1).Range("a2")
    ' ...
End Sub
 
Function GetAnotherWorkbook() As Workbook
    ' если в данный момент открыто 2 книги, функция возвратит вторую открытую книгу
    ' если помимо текущей, открыто более одной книги - будет предоставлен выбор
    On Error Resume Next
    Dim coll As New Collection, WB As Workbook
    For Each WB In Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            If Windows(WB.Name).Visible Then coll.Add CStr(WB.Name)
        End If
    Next WB
    Select Case coll.Count
        Case 0    ' нет других открытых книг
            MsgBox "Нет других открытых книг", vbCritical, "Function GetAnotherWorkbook"
        Case 1    ' открыта ещё только одна книга - её и возвращаем
            Set GetAnotherWorkbook = Workbooks(coll(1))
        Case Else    ' открыто несколько книг - предоставляем выбор
            For i = 1 To coll.Count
                txt = txt & i & vbTab & coll(i) & vbNewLine
            Next i
            msg = "Выберите одну из открытых книг, и введите её порядковый номер:" & _
                  vbNewLine & vbNewLine & txt
            res = InputBox(msg, "Открыто более двух книг", 1)
            If IsNumeric(res) Then Set GetAnotherWorkbook = Workbooks(coll(Val(res)))
    End Select
End Function