编写VBA代码：从500个工作簿提取指定单元格数据生成汇总表格

核心方案：用VBA脚本自动化处理 #

面对500个工作簿的批量数据提取，手动操作效率极低，Excel VBA是最直接的自动化解决方案，以下是完整实现代码和操作步骤：

代码实现 #

打开一个新Excel文件，按Alt+F11进入VBA编辑器，插入新模块后粘贴以下代码：

Sub BatchExtractData()
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWB As Workbook
    Dim summaryWS As Worksheet
    Dim currentRow As Long
    
    ' 指定汇总表（当前工作簿的Sheet1）
    Set summaryWS = ThisWorkbook.Sheets("Sheet1")
    currentRow = 1 ' 若汇总表已添加表头，改为2
    
    ' 选择存放目标工作簿的文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder with Target Workbooks"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "No folder selected, exiting."
            Exit Sub
        End If
    End With
    
    ' 遍历文件夹内的所有xlsx文件
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' 只读打开源工作簿，避免锁定文件
        Set sourceWB = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        
        ' 从Sheet1提取数据到A-C列
        summaryWS.Cells(currentRow, "A").Value = sourceWB.Sheets(1).Range("B2").Value
        summaryWS.Cells(currentRow, "B").Value = sourceWB.Sheets(1).Range("B6").Value
        summaryWS.Cells(currentRow, "C").Value = sourceWB.Sheets(1).Range("B8").Value
        
        ' 从Sheet2提取数据到D-F列
        summaryWS.Cells(currentRow, "D").Value = sourceWB.Sheets(2).Range("B2").Value
        summaryWS.Cells(currentRow, "E").Value = sourceWB.Sheets(2).Range("C2").Value
        summaryWS.Cells(currentRow, "F").Value = sourceWB.Sheets(2).Range("D2").Value
        
        ' 从Sheet3提取数据到G-H列（原需求仅两个单元格，I列留空）
        summaryWS.Cells(currentRow, "G").Value = sourceWB.Sheets(3).Range("B6").Value
        summaryWS.Cells(currentRow, "H").Value = sourceWB.Sheets(3).Range("D6").Value
        
        ' 关闭源工作簿，不保存修改
        sourceWB.Close SaveChanges:=False
        
        currentRow = currentRow + 1
        fileName = Dir
    Loop
    
    MsgBox "Extraction completed! Processed " & currentRow - 1 & " workbooks."
End Sub

使用步骤 #

1. 将新建的Excel文件保存为启用宏的工作簿（.xlsm格式）——普通.xlsx文件不支持宏，必须用该格式才能运行代码。
2. 回到Excel界面，按Alt+F8调出宏窗口，选择BatchExtractData点击执行。
3. 在弹出的文件夹选择窗口中，选中存放500个工作簿的文件夹，等待程序运行完成即可。

优化与注意事项 #

• 工作表名称适配：如果源工作簿的工作表有自定义名称（而非默认顺序），把代码里的Sheets(1)改成Sheets("具体工作表名")，比如Sheets("月度数据")，避免因工作表顺序变动导致提取错误。
• 提升运行速度：处理大量文件时，可在代码开头添加Application.ScreenUpdating = False，结尾添加Application.ScreenUpdating = True，关闭屏幕刷新后运行速度会明显提升。
• 异常处理：若部分工作簿格式异常（如缺少指定工作表或单元格），可添加On Error Resume Next错误捕获语句，避免程序中途崩溃，后续可追加判断逻辑标记异常文件。

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