改写后的过程如下：

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 Variant '要合并的工作簿名称
Dim a As Long, b As Long
Set ToSht = ThisWorkbook.Worksheets(1)
ToSht.Rows("2:1048576").Clear '清除原有数据
FileName = Application.GetOpenFilename(filefilter:="Excel工作簿文件,*.xls?", Title:="请选择文件", MultiSelect:=True)
If TypeName(FileName) = "Boolean" Then Exit Sub
Dim Fil As Variant
For Each Fil In FileName
Workbooks.Open FileName:=Fil
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
Next Fil
Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub

上一篇：xcel表格制作教程入门：大白话告诉你，这几个提取字串的Excel函数居然这么好用！ 下一篇：excel表格制作教程：数据录入的这些坑，你有没有被坑过

郑重声明：本文版权归原作者所有，转载文章仅为传播更多信息之目的，如作者信息标记有误，请第一时间联系我们修改或删除，多谢。