vba-合并工作薄

`Option Explicit
Sub 合并()
Dim arr
Dim i, n As Integer 'i 循环打开的工作薄里的工作表，n 计数用
Dim allwb As String '存放弹出工作薄的名称
Dim wb As Workbook '当前打开的工作薄
Dim x As Integer '用于存放最后一行行号
Dim rowi As Long 'copy到的行数
Dim sr As String '文件夹地址
Dim ssr As String '遍历出来的文件名
Application.ScreenUpdating = False '禁止屏幕刷新
On Error Resume Next '屏蔽错误提示
Cells.Clear '清空
sr = "C:\Users\110\Desktop\123" & Application.PathSeparator '待合并工作薄所在路径
ssr = Dir(sr & ".xls") '打开哪种类型文件
allwb = ssr '初始化弹出工作薄的名称
rowi = 1 '初始化copy开始位置
n = 0 '初始化数量
Do
Set wb = Workbooks.Open(sr & ssr) '新打开的工作薄赋值给wb
For i = 1 To wb.Worksheets.Count
If Application.WorksheetFunction.CountA(wb.Worksheets(i).Cells) > 0 Then
x = wb.Worksheets(i).Cells.Find("*", Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '有数据的最大行所在行号
wb.Worksheets(i).Range("1:" & x).Copy ThisWorkbook.Sheets(1).Range("a" & rowi) '复制粘贴
rowi = rowi + x 'copy到的位置更新
End If
Next
wb.Close '关闭工作薄
ssr = Dir '遍历下一个工作薄
n = n + 1 '计算工作簿数
allwb = allwb & Chr(13) & ssr '连接已合并工作簿名称
Loop Until ssr = ""
Cells.RowHeight = 15 '将所有行高设置为 15
MsgBox "共合并了" & n & "个工作薄下的全部工作表。如下：" _
& Chr(13) & allwb, vbInformation, "提示" '弹出提示
Application.ScreenUpdating = False '恢复屏幕刷新
End Sub

`