如何用VBA从批量生成的工作簿中提取指定数据生成列表？

步骤1：创建汇总工作簿 #

新建一个空白Excel工作簿，命名为「员工奖金汇总.xlsx」，保存到你方便的位置。

步骤2：编写汇总用VBA代码 #

1. 打开这个汇总工作簿，按下 Alt + F11 打开VBA编辑器。
2. 右键点击左侧的「VBAProject(员工奖金汇总.xlsx)」，选择「插入」→「模块」。
3. 将以下代码粘贴到模块中：

Sub 汇总员工奖金数据()
    Dim 源文件夹路径 As String
    Dim 文件名 As String
    Dim 源工作簿 As Workbook
    Dim 汇总工作表 As Worksheet
    Dim 当前行 As Integer
    
    ' 设置汇总工作表（默认用第一个工作表）
    Set 汇总工作表 = ThisWorkbook.Sheets(1)
    ' 写入表头
    汇总工作表.Cells(1, 1) = "员工文件名"
    汇总工作表.Cells(1, 2) = "A1单元格值"
    汇总工作表.Cells(1, 3) = "A2单元格值"
    当前行 = 2 ' 从第二行开始写入数据
    
    ' 选择要遍历的文件夹（就是之前生成员工工作簿的文件夹）
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择员工工作簿所在的文件夹"
        If .Show = -1 Then
            源文件夹路径 = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹，程序退出"
            Exit Sub
        End If
    End With
    
    ' 遍历文件夹中的xlsx文件
    文件名 = Dir(源文件夹路径 & "*.xlsx")
    Do While 文件名 <> ""
        ' 跳过汇总工作簿本身，避免重复读取
        If 文件名 <> ThisWorkbook.Name Then
            ' 后台打开源工作簿（不显示界面）
            Set 源工作簿 = Workbooks.Open(Filename:=源文件夹路径 & 文件名, ReadOnly:=True)
            ' 提取数据到汇总表
            汇总工作表.Cells(当前行, 1) = 文件名
            汇总工作表.Cells(当前行, 2) = 源工作簿.Sheets(1).Range("A1").Value
            汇总工作表.Cells(当前行, 3) = 源工作簿.Sheets(1).Range("A2").Value
            ' 关闭源工作簿，不保存任何修改
            源工作簿.Close SaveChanges:=False
            ' 行数自增
            当前行 = 当前行 + 1
        End If
        ' 获取下一个文件名
        文件名 = Dir()
    Loop
    
    MsgBox "汇总完成！"
End Sub

步骤3：运行代码 #

1. 回到汇总工作簿，按下 Alt + F8，选择「汇总员工奖金数据」并点击「运行」。
2. 在弹出的对话框中选择之前生成员工工作簿的文件夹，等待程序执行完成即可。

注意事项 #

• 确保所有要汇总的员工工作簿都是.xlsx格式，若有.xls等其他格式，需修改代码中的Dir(源文件夹路径 & "*.xlsx")为对应后缀。
• 运行前请关闭所有正在编辑的员工工作簿，避免文件占用导致报错。
• 若员工工作簿的A1、A2数据在非第一个工作表中，需修改代码里的源工作簿.Sheets(1)为对应工作表名称（比如源工作簿.Sheets("calculate")）。

内容的提问来源于stack exchange，提问作者Qarq