Как импортировать вторую рабочую книгу, получить ее лист и вставить ее в мой текущий лист

Question

Я ищу комплексное решение для чтения листов из существующих рабочих книг в выбранном каталоге и добавления моего существующего отдельного листа в основную рабочую книгу. Расположение входных файлов может быть изменено, поэтому я думаю, что лучше использовать методы OpenFile и автоматически получать пути к файлам.

Дело в том, что у меня есть, например, 500 загруженных рабочих тетрадей из статистического управления, каждая из которых включает только один лист, а структура данных всегда одинакова. Те же столбцы, те же типы данных внутри. Вообще один предмет моего исследования.

Я нашел этот пример (https://www.excelcampus.com/vba/copy-paste-another-workbook/ - «Вставка под последнюю ячейку»), но я не знаю, как изменить источник местоположения.

Мой текущий код:

Sub openAndCopyData()

    Dim importedFile As Variant

    importedFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx*;")

    If importedFile <> False Then
    Workbooks.Open Filename:=importedFile
    End If

    Dim sheetToCopy As Worksheet
    Dim sheetToPaste As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long

    Set sheetToCopy = importedFile.Sheets("Sheet1")
    Set sheetToPaste = ThisWorkbook.Sheets("Sheet1")

    lCopyLastRow = sheetToCopy.Cells(sheetToCopy.Rows.Count, "A").End(xlUp).Row
    lDestLastRow = sheetToPaste.Cells(sheetToPaste.Rows.Count, "A").End(xlUp).Offset(1).Row

    sheetToCopy.Range("A2:D" & lCopyLastRow).Copy _
    sheetToPaste.Range("A" & lDestLastRow)


End Sub

Я хочу добавить добавленные данные в мой основной лист после импорта каждого из моих файлов из-за его параллельной структуры. Если это будет работать, я представлю методы фильтрации и другие улучшения.

Answer 1

, если цель вашего вопроса состоит в том, чтобы пройтись по всем выбранным файлам для копирования, тогда можно попробовать

Sub openAndCopyData()
    Dim importedFile As Variant
    'importedFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx*;")
    importedFile = Application.GetOpenFilename("Excel Files,*.xlsx*;", 1, _
"Select Files to Copy", "Get Data from Files", True)

    If TypeName(importedFile) = "Boolean" And Not (IsArray(importedFile)) Then Exit Sub

    Dim sheetToCopy As Worksheet
    Dim sheetToPaste As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    Dim i As Long


    For i = 1 To UBound(importedFile)
    Set Wb = Workbooks.Open(importedFile(i))
    Set sheetToCopy = Wb.Sheets("Sheet1")
    Set sheetToPaste = ThisWorkbook.Sheets("Sheet1")
    lCopyLastRow = sheetToCopy.Cells(sheetToCopy.Rows.Count, "A").End(xlUp).Row
    lDestLastRow = sheetToPaste.Cells(sheetToPaste.Rows.Count, "A").End(xlUp).Offset(1).Row
    sheetToCopy.Range("A2:D" & lCopyLastRow).Copy _
    sheetToPaste.Range("A" & lDestLastRow)
    Wb.Close False
    Next
End Sub

код проверен с временными файлами данных.