多个单独的excel表格，把每个表格4b位置的数提取出来，求一个代码小程序之类的，给大神跪了

以下是一个使用VBA编写的宏代码，它可以实现你所描述的功能：将指定文件夹中所有工作簿的B4单元格内容提取到一个新的工作簿中。
vba
Sub ExtractB4CellContents()
Dim folderPath As String
Dim file As String
Dim wb As Workbook
Dim ws As Worksheet
Dim newWb As Workbook
Dim newWs As Worksheet
Dim rowIndex As Long
'显示文件夹选择对话框，获取文件夹路径
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择文件夹"
.AllowMultiSelect = False
网页链接 = -1 Then
folderPath =.SelectedItems(1)
Else
MsgBox "未选择文件夹，程序终止。"
Exit Sub
End If
End With
'创建新的工作簿用于存放提取的数据
Set newWb = 网页链接 Set newWs = newWb.Worksheets(1)
newWs.Cells(1, 1).Value = "文件名"
newWs.Cells(1, 2).Value = "B4单元格内容"
rowIndex = 2
'遍历文件夹中的所有文件
file = Dir(folderPath & "\*.xls*")
Do While file <> ""
'打开工作簿
Set wb = Workbooks.Open(folderPath & "\" & file)
Set ws = wb.Worksheets(1)'假设数据在第一个工作表中，可根据实际情况修改
'提取B4单元格内容
newWs.Cells(rowIndex, 1).Value = file
newWs.Cells(rowIndex, 2).Value = ws.Cells(4, 2).Value
'关闭工作簿
网页链接 False
rowIndex = rowIndex + 1
file = Dir
Loop
'提示用户数据已提取完成
MsgBox "数据已成功提取到新工作簿中。"
End Sub
使用方法：
1.打开Excel应用程序，按下 Alt + F11 组合键打开VBA编辑器。
2.在VBA编辑器中，插入一个新的模块（在“插入”菜单中选择“模块”）。
3.将上述代码粘贴到新模块的代码窗口中。
4.按下 F5 键运行宏，或者返回Excel工作表界面，通过“开发工具”选项卡（如果没有显示开发工具选项卡，需要在Excel选项中启用）找到“宏”，选择 ExtractB4CellContents 并运行。
5.按照提示选择包含工作簿的文件夹，程序会自动提取所有工作簿B4单元格的内容并生成一个新的汇总工作簿。
注意事项：
1.代码中假设每个工作簿的数据都在第一个工作表（ws = wb.Worksheets(1)），如果实际情况不是这样，需要修改这部分代码以指向正确的工作表。
2.代码只处理扩展名为 .xls、.xlsx 等常见Excel文件格式的工作簿，如果你有其他特殊格式的文件，可能需要进一步修改代码。

b4单元格吧？简单，提取到哪里你说清楚。

大神也是要吃饭的，建议出门右转找淘宝

你有描述需求的时间，不如去问AI

提示词：先创建一个新的Excel工作簿，然后让用户选择多个Excel文件，最后遍历这些文件的所有工作表，最后在新工作表的A列中依次逐行复制每个工作表的B4单元格数据。

Sub CopyB4FromMultipleWorkbooksToColumnA() Dim newWorkbook As Workbook Dim selectedFiles As Variant Dim i As Integer Dim sourceWorkbook As Workbook Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim rowCounter As Integer Dim fileDialog As FileDialog ' 创建一个新的工作簿用于汇总数据 Set newWorkbook = Workbooks.Add Set targetSheet = newWorkbook.Sheets(1) targetSheet.Name = "汇总数据" ' 初始化行计数器（从第1行开始） rowCounter = 1 ' 设置文件选择对话框 Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) With fileDialog .Title = "请选择要处理的Excel文件" .Filters.Clear .Filters.Add "Excel文件", "*.xls; *.xlsx; *.xlsm" .AllowMultiSelect = True ' 显示文件选择对话框 If .Show <> -1 Then MsgBox "未选择任何文件，操作已取消。", vbInformation Exit Sub End If selectedFiles = .SelectedItems End With ' 关闭屏幕更新以提高性能 Application.ScreenUpdating = False ' 遍历所有选中的文件 For i = LBound(selectedFiles) To UBound(selectedFiles) ' 打开源工作簿 Set sourceWorkbook = Workbooks.Open(selectedFiles(i), ReadOnly:=True) ' 遍历工作簿中的所有工作表 For Each sourceSheet In sourceWorkbook.Worksheets ' 将B4单元格的值复制到目标工作簿的A列 targetSheet.Cells(rowCounter, 1).Value = sourceSheet.Range("B4").Value rowCounter = rowCounter + 1 Next sourceSheet ' 关闭源工作簿 sourceWorkbook.Close SaveChanges:=False Next i ' 恢复屏幕更新 Application.ScreenUpdating = True ' 自动调整列宽 targetSheet.Columns("A:A").AutoFit ' 提示完成 MsgBox "已完成从 " & UBound(selectedFiles) - LBound(selectedFiles) + 1 & " 个文件中提取数据，共处理 " & rowCounter - 1 & " 个工作表。", vbInformation ' 保存新工作簿 Dim savePath As String savePath = Application.GetSaveAsFilename( _ FileFilter:="Excel 文件 (*.xlsx), *.xlsx", _ Title:="保存汇总结果", _ InitialFileName:="汇总结果.xlsx") If savePath <> "False" Then newWorkbook.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook MsgBox "汇总结果已保存到: " & savePath, vbInformation Else MsgBox "未保存汇总结果。", vbExclamation End IfEnd Sub

我可以给你做小软件，让你办公自动化，不仅仅是只提取这些

我有这个小程序

这个是多表合并或多表汇总的场景，要看你取出来后要怎么处理