Question

我是VBA的新手，但我想利用excel vba来提高我的工作效率。因此，我来这里是为了获得所有善良灵魂的帮助。问题如下：

我在网络文件夹中有多个excel文件。这些文件在名称共享中共享相似性，但不是整个文件名。例如。 a b c d e v19_01Nov2012，a b c d e v19_02Nov2012，a b c d e v19_05Nov2012等。这些文件有各种工作表，即sheetA，sheetB等。

接下来，我有一个文件＆＃34; Nov2012.xlxs＆＃34;合并从位于网络文件夹中的上述文件中提取的所有信息。该文件有各种工作表，即sheetA，sheetB等。

我想做什么：我需要打开网络文件夹中的每个excel文件，并在单元格中提取数据＆＃34; B17＆＃34;来自工作表＆＃34; sheetA＆＃34;到Nov2012.xlxs工作表＆＃34; sheetA＆＃34;细胞＆＃34; B2＆＃34;。

需要注意的事项：Nov2012.xlxs A列中的内容包括11月的所有日期（例如01Nov2012,02Nov2012,03Nov2012等）。打开b c d e v19_01Nov2012时，单元格中的数据＆＃34; B17＆＃34;来自工作表＆＃34; sheetA＆＃34;应复制到包含＆＃34; 01Nov2012＆＃34;的Nov2012.xlxs行来自工作表＆＃34; sheetA＆＃34;和细胞＆＃34; B2＆＃34;。

目前我正在处理此代码：

Sub FolderCrawler()
FileType = "*.xls*" 'The file type to search for
FilePath = "C:\Nov\" 'The folder to search

Dim OutputCol As Variant
Dim Curr_File As Variant
Dim FldrWkbk As Workbook

OutputCol = 1 'The first row of the active sheet to start writing to
ThisWorkbook.ActiveSheet.Range(Cells(3, OutputCol), Cells(3, OutputCol)) = FilePath & FileType

OutputCol = OutputCol + 1

Curr_File = Dir(FilePath & FileType)

Do Until Curr_File = ""
Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, False, True) 'Open new data file
Sheets("sheetA").Range("B17").Copy 'Copy data from specific Range

'Move back to Master file
Workbooks("01Nov2012.xlsm").Activate
Sheets("sheetA").Cells(4, OutputCol).Select
ActiveSheet.Paste

OutputCol = OutputCol + 1
FldrWkbk.Close SaveChanges:=False 'Close the data file

Curr_File = Dir 'Select Next File
Loop
Set FldrWkbk = Nothing
End Sub

目前，我遇到＆＃34;运行时错误＆＃39; 9＆＃39;：下标超出范围＆＃34;。知道问题出现的原因吗？

Answer 1

我怀疑您在文件之间切换时丢失了对正确工作簿的引用。您可能需要参考工作簿而不仅仅是工作表：FldrWkbk.Sheets("sheetA").Range("B17").Copy

话虽如此，是否有理由需要复制/粘贴？如果可能，我会避免这种情况。设置对主文件的引用：

Dim masterBook As Workbook
Set masterBook = ThisWorkbook

然后，在设置FldrWkbk之后，将有问题的文件中的值分配回主文件：

masterBook.Sheets("sheetA").Cells(4, OutputCol).Value = FldrWkbk.Sheets("sheetA").Range("B17").Value

这也避免了使用导致许多问题的.Select和.Activate命令。

VBA - 从文件夹中的多个文件中提取数据并导入到单个文件

1 个答案: