数据处理，一般需要从企业系统中导出20多万，导出的表是一个工作簿，20多万的数据，每个工作表6万条，约4-6个工作表组成一个工作簿。
现需要将几个工作表的数据合并在一个工作表中，以便于数据处理。
我编制了一个VBA宏，运行后，发现每个工作表为6万条记录的第6万条记录没合并到新工作表中，麻烦大佬给指点下。具体程序如下：
Sub 多工作簿合并()
Dim file() As String, filestr As String, n As Integer, m As Integer, pathstr As String, namess As String, activewb As Workbook, cell As Range
With Application.FileDialog(msoFileDialogFolderPicker)
'创建文件对话框的实例
If .Show Then '如果在对话框中单击了“确定”按钮
  pathstr = .SelectedItems(1) '将选定的路径赋予变量
Else
 Exit Sub '否则退出程序
End If
End With
On Error Resume Next
filestr = Dir(pathstr & IIf(Right(pathstr, 1) = "\", "", "\") & "*.xls")
'获取路径下第一个文件名
While Len(filestr) > 0 '只要文件名长度大于零就循环下去
n = n + 1 '累加变量，该变量等于文件个数
ReDim Preserve file(1 To n) '重新指定数组变量的存储空间
file(n) = pathstr & IIf(Right(pathstr, 1) = "\", "", "\") & filestr
'将路径与文件名逐个写入数组
filestr = Dir()
Wend
If n = 0 Then MsgBox "没发现excel文件": Exit Sub  '如果没有文件则退出程序
Set activewb = ActiveWorkbook '将活动工作簿赋予变量
Application.ScreenUpdating = False '关闭屏幕更新，从而提速
Application.Calculation = xlCalculationManual '计算模式调用手动，从而提速
For k = 1 To n '遍历文件夹中所有excel文件
namess = Dir(file(k)) '获取文件夹的名称（忽略路径）
Workbooks.Open FileName:=file(k)   '打开文件
activewb.Activate '返回存放合并数据的工作表
'如果K=1,那么将标题复制到活动工作表A1
For i = 1 To Workbooks(namess).Sheets.Count
'遍历所有工作表，开始合并标题以外的数据
With Workbooks(namess).Sheets(i).UsedRange
'引用待合并工作簿中每个工作表的已用区域
If Not IsEmpty(Workbooks(namess).Sheets(i).UsedRange) Then
'如果非空表
'将合并工作表已用区域的下一行第1个单元格赋予变量（即将合并工作表的A列第一个空单元格赋值给变更cell）
Set cell = Cells(ActiveSheet.UsedRange.Rows.Count, 1)
'将目标数据除标题外全部复制到cell单元格（此次复制，仅仅需要其格式）
cell.Resize(.Rows.Count, .Columns.Count) = .Cells.Value
End If
End With
Next i '合并下一个工作表
Workbooks(namess).Close False '关闭工作簿且不保存
Next k
Application.ScreenUpdating = True '恢复屏幕更新
Application.Calculation = xlCalculationAutomatic '恢复自动计算
End Sub

把上述文件解压至一个文件夹中，然后运行上面的宏，其中sheet1第60000条图号为C13228、sheet2第60000条图号为C28228、sheet3第60000条图号为C43228的记录在合并后的sheet表中查不到。求版主指教！

感谢版主！这段程序对于一个工作簿中多个工作表的合并确认非常快。如果是多个相同格式的工作簿中的多个工作表的合并，麻烦版主看看有没有好的处理办法。

具体的数据如下，麻烦版主给看下。