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

代码已通过临时数据文件进行了测试。

如何导入第二个工作簿，获取其工作表并将其粘贴到当前工作表中

1 个答案: