Question

我将不胜感激任何帮助！我试图找出正确的代码，以便动态地从文件夹＆＃34; 2017＆＃34; （如下所示）中提取。在这个文件夹中有许多excel工作簿。从那里，vba将一系列单元格复制并粘贴到原始工作簿中。到目前为止，代码非常手动，每当我尝试切换文件夹原点时，我必须在代码中手动更改它。

有人能够协助我编辑动态代码吗？例如：我希望实现的是，如果文件夹的名称在单元格 A1 中。然后vba代码将打开文件夹并从单元格 A1 中的任何名称中提取工作簿。

如果我能提供任何其他信息，请告诉我们！

提前谢谢你！

  Sub ArrDepMerge2017()


Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim c As Long

Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set dirObj = mergeObj.Getfolder("2017")
Set filesObj = dirObj.Files

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    c = c + 1
    bookList.Sheets(1).Range("F37:F53").Copy ThisWorkbook.Worksheets("2017 Data").Cells(1, c)
    bookList.Close

End Sub

Answer 1

您将单元格值分配给变量，例如路径，然后在您的GetFolder中使用它。此外，在使用For Each时添加Next everyobj。

Sub ArrDepMerge2017()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim c As Long
Dim path as String

path = ThisWorkbook.Sheets("mysheetname").Range("myrange")

Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set dirObj = mergeObj.Getfolder(path)
Set filesObj = dirObj.Files

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    c = c + 1
    bookList.Sheets(1).Range("F37:F53").Copy ThisWorkbook.Worksheets("2017 Data").Cells(1, c)
    bookList.Close
Next everyObj ' this was missing

End Sub

从指定的单元格打开文件/文件夹

1 个答案: