【VBA、Excel】VBA遍历当前目录下指定类型的excel文件并复制文件内指定的内容到新表中

最近在做水质分析数据录入的时候，需要根据监测井编号到多个excel表中查询该编号对应的井的水质分析数据，并将单口井的水质分析数据复制到新表中。由于检测中心给的

水质分析数据很多，而且还分布在不同的工作薄中，一个个得查询再复制不仅工作量巨大、而且容易出错。因此编写了以下代码，让这部分工作实现自动化。

 

这部分内容涉及的知识点有：多工作薄交叉复制、获取某一目录下所有excel工作薄、获取某一目录下所有指定类型excel工作薄、创建工作薄、打开工作薄并操作

 

现在把代码整理贴出来，方便以后参考调用。

 

代码如下：

Option Explicit




Sub test()
    Dim dict, i, v
    Set dict = CreateObject("Scripting.Dictionary") '创建dictionary
    i = 1
    Do While Cells(i, 1) <> "" '遍历当前excel文件第一列内容，直到第一列单元格值为空
        dict.Add i, Cells(i, 1).Text '将第一列单元格的值添加到dict中
        i = i + 1
    Loop
    Create_New_Workbook
    v = dict.Items
    For i = 0 To dict.Count - 1
        HuiZong (v(i))
    Next i


End Sub


Function HuiZong(WellId As String)
    Dim myfile, mypath, wb