Экспорт данных из другой книги при динамичном индексе и имени книги

Автор Noob2, 12 декабря 2022, 10:15

Noob2

Добрый день.
Мне на почту приходят ексель файлы.  Написал просто код

Workbooks(2).ActiveWorkSheet.Range("A1").Copy
ThisWorkbook.Worksheets(1).Range("A1").Paste

Все работает, если закрыть все документы и оставить только эти два.
Вопрос, Вообще возможно Экспорт данных из другой книги при динамичном индексе и имени книги.

Администратор

Напишите словесное описание задачи, которую вы хотите сделать. Без использовании программных терминов. Просто словесное описание.

Noob2

Нашел интересное решение. Диалоговый бокс который предлагает на выбор с какой книгой работать. 



Dim WB As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
    On Error Resume Next
   
    Set WS1 = ThisWorkbook.ActiveSheet
    Set WB = GetAnotherWorkbook




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