mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

Часто бывает, что надо получить данные из другой, открытой вместе с используемой, книги Excel.

Данная функция помогает получить ссылку на другую, открытую в текущий момент, книгу:

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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Попробуйте так:

Sub Пример()
    Dim WB As Workbook
    Set WB = GetAnotherWorkbook
 
    If Not WB Is Nothing Then ' если книга открылась, то
    
        ' копируем столбцы
        WB.Worksheets(1).Columns("A:J").Copy ThisWorkbook.ActiveSheet.Range("A1")
 
        ' закрываем книгу-источник, если она больше не нужна
        WB.Close False
    End If
End Sub

PS: Ваш код слишком плох, чтобы использовать его во внешнем макросе (много лишнего с коде, - обратите внимание, я из вашего кода сделал одну строку)
И ещё, - копируя столбцы целиком, - я не понимаю, как из можно вставить, начиная с ячейки A2 (столбцы по высоте не влезут) - потому исправил A2 на A1

А скажите как после выбора файла выполнить следующие действия:
Columns("A:J").Select
Range("J1").Activate
Selection.Copy
Selection.Copy
Windows("Книга5.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
добавляю после строки ' ... ничего не происходить, работает макрос не на выбраном мною файле, а на открытом Книга5, а мне нужно из файла Книга2 скопировать данные в книгу5

Классно работает. Вставила в свой код. Давно не хватало мне этого. Я из одного файла заполняю каждый раз новые файлы. И все время прописывала в коде названия файлов, а теперь красота: Открываю заранее и при работе макроса выбираю нужный. Спасибо!!

Извиняюсь код работает - ошибка при копировании. Игорь.

Скопировал я данный код в модуль, половина кода отмечается как ошибка (красным). Возникает вопрос зачет такие коды предлагать как примеры? Игорь.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
      _   ____    _      __  __  _____   __  __ 
__| | | __ ) | | \ \/ / |_ _| | \/ |
/ _` | | _ \ | | \ / | | | |\/| |
| (_| | | |_) | | |___ / \ | | | | | |
\__,_| |____/ |_____| /_/\_\ |_| |_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.