利用VBA提取一个文件夹下面所有子文件夹内的后缀名为.xlsx文件的d1到d13和e1到e13单元格内的所有内容,并按照文件路径分类,组合到一个新的xlsx文件内,并将该文件放置到当前文件夹下的代码
时间: 2024-09-14 07:05:38 浏览: 40
Excel VBA 操作 拆分当前Excel表中 / 所选取文件夹所有子文件中 所有sheet保存到对应文件夹路径中拆分表内
5星 · 资源好评率100%
在VBA中,你可以使用`Dir`, `Fso`, 和 `CreateObject("Excel.Application")`等对象来实现这个功能。以下是一个基本的示例代码,用于遍历指定文件夹及其子文件夹,提取`.xlsx`文件中的特定单元格数据并将其合并到新的工作簿中:
```vba
Sub CombineXLSXData()
Dim folderPath As String
Dim excelApp As Object
Dim workbook As Workbook
Dim subWorkbook As Workbook
Dim ws As Worksheet
Dim file As String
Dim startRow As Long
Dim endRow As Long
Dim rng As Range
' 设置文件夹路径
folderPath = "你的文件夹路径" ' 请替换为你需要处理的实际文件夹路径
' 创建Excel应用实例
Set excelApp = CreateObject("Excel.Application")
' 新建工作簿保存结果
Set workbook = excelApp.Workbooks.Add
' 开始行和结束行
startRow = 1
endRow = 13
' 遍历文件夹和子文件夹
For Each file In Dir(folderPath & "\*.xlsx", vbNormal)
If Right(file, 4) = ".xlsx" Then
' 打开每个Excel文件
Set subWorkbook = excelApp.Workbooks.Open(folderPath & "\" & file)
' 检查是否包含所需范围
On Error Resume Next
Set ws = subWorkbook.Sheets(1).Range("d1:e13")
On Error GoTo 0
' 如果找到了范围,则提取数据并添加到新工作簿
If Not ws Is Nothing Then
ws.Copy Destination:=workbook.Worksheets(workbook.Worksheets.Count + 1)
' 获取目标工作表的引用
Set ws = workbook.Worksheets(workbook.Worksheets.Count)
' 将行数累加到endRow
endRow = endRow + 1
End If
' 关闭打开的工作簿
subWorkbook.Close False
End If
Next file
' 保存结果到新工作簿
workbook.SaveAs Filename:="结果.xlsx", FileFormat:=xlOpenXMLWorkbook
' 关闭Excel应用
excelApp.Quit
' 清理内存
Set workbook = Nothing
Set ws = Nothing
Set excelApp = Nothing
End Sub
```
记得把"你的文件夹路径"替换为实际的文件夹路径。运行这段代码后,它会在指定文件夹下创建一个名为"结果.xlsx"的新文件,包含了所有子文件夹中`.xlsx`文件的"D1:E13"范围的数据。
阅读全文