Excel教程：将指定文件夹中所有工作簿里的数据合并到同一工作表中

办公教程导读

收集整理了【Excel教程：将指定文件夹中所有工作簿里的数据合并到同一工作表中】办公软件教程，小编现在分享给大家，供广大互联网技能从业者学习和参考。文章包含2159字，纯文字阅读大概需要4分钟。

办公教程内容图文

本文为《别怕，Excel VBA其实特别简单（第3版）》随书问题参考答案

如果要合并数据的工作簿保存在代码所在目录下，名为“我的文件”的文件夹中，要合并这些文件中第一张工作表的数据，可以用下面的过程：

Sub 合并多工作簿第一张表的数据()
Application.ScreenUpdating = False
Dim DataArr As Variant, DataWb As Workbook, DataSht As Worksheet
Dim EndRow As Long, ToSht As Worksheet, ToRng As Range
Dim FileName As String '要合并的工作簿名称
Dim a As Long, b As Long
Set ToSht = ThisWorkbook.Worksheets(1)
ToSht.Rows("2:1048576").Clear '清除原有数据
FileName = Dir(ThisWorkbook.Path & "\我的文件\*.xls?")
Do While FileName ""
Workbooks.Open FileName:=ThisWorkbook.Path & "\我的文件\" & FileName
Set DataWb = ActiveWorkbook
Set DataSht = DataWb.Worksheets(1)
EndRow = DataSht.Range("A1048576").End(xlUp).Row
DataArr = DataSht.Range("A2").Resize(EndRow - 1, 8).Value
Set ToRng = ToSht.Range("A1048576").End(xlUp).Offset(1, 0)
For a = 1 To UBound(DataArr, 1) '将数组中超过15位的数字转为文本
For b = 1 To UBound(DataArr, 2)
If Len(DataArr(a, b)) > 15 Then
DataArr(a, b) = "'" & DataArr(a, b)
End If
Next b
Next a
ToRng.Resize(UBound(DataArr, 1), 8).Value = DataArr
DataWb.Close savechanges:=False
FileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub

如果工作簿中保存了多张工作表，要合并所有工作表中的数据，过程可以改写为：

Sub 合并多工作簿所有工作表的数据()
Application.ScreenUpdating = False
Dim DataArr As Variant, DataWb As Workbook, DataSht As Worksheet
Dim EndRow As Long, ToSht As Worksheet, ToRng As Range
Dim FileName As String '要合并的工作簿名称
Dim a As Long, b As Long
Set ToSht = ThisWorkbook.Worksheets(1)
ToSht.Rows("2:1048576").Clear '清除原有数据
FileName = Dir(ThisWorkbook.Path & "\我的文件\*.xls?")
Do While FileName ""
Workbooks.Open FileName:=ThisWorkbook.Path & "\我的文件\" & FileName
Set DataWb = ActiveWorkbook
For Each DataSht In DataWb.Worksheets
EndRow = DataSht.Range("A1048576").End(xlUp).Row
DataArr = DataSht.Range("A2").Resize(EndRow - 1, 8).Value
Set ToRng = ToSht.Range("A1048576").End(xlUp).Offset(1, 0)
For a = 1 To UBound(DataArr, 1) '将数组中超过15位的数字转为文本
For b = 1 To UBound(DataArr, 2)
If Len(DataArr(a, b)) > 15 Then
DataArr(a, b) = "'" & DataArr(a, b)
End If
Next b
Next a
ToRng.Resize(UBound(DataArr, 1), 8).Value = DataArr
Next DataSht
DataWb.Close savechanges:=False
FileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub

你发现第二个过程在第一个过程的基础上，改动了哪些地方吗？

办公教程总结

以上是为您收集整理的【Excel教程：将指定文件夹中所有工作簿里的数据合并到同一工作表中】办公软件教程的全部内容，希望文章能够帮你了解办公软件教程Excel教程：将指定文件夹中所有工作簿里的数据合并到同一工作表中。
如果觉得办公软件教程内容还不错，欢迎将网站推荐给好友。