工作簿合并-GetOpenFilename-奔溃

fangzuike

各位好。
      编写了一个日报表工作簿分别汇总的vba，数据量不算大，但是合并20几个日报表的时候，就奔溃了。
      请高手帮助看看，是否存在bug？能否改进？
      谢谢了。
代码在sheet1，文件见附件。
Private Sub CommandButton1_Click()
'需求，将单个日对账单明细合并显示到目标工作表，20200922
Sheet2.Name = "02、银行卡明细"          '重新命名
Sheet3.Name = "03、扫码明细"
Sheet4.Name = "04、其他费用明细"
Sheet2.Range("a1:t10000").ClearContents '初始清理一万行
Sheet3.Range("a1:r10000").ClearContents
Sheet4.Range("a1:f10000").ClearContents
Dim str()
Dim i, j, k, p As Integer
Dim m, n As Integer
Dim wb, wb1 As Workbook
On Error Resume Next         '避免未选择工作簿导致错误
Application.ScreenUpdating = False  '关闭运算演示
Set wb1 = ActiveWorkbook     '合并目标工作簿
str = Application.GetOpenFilename("Excel数据文件,*.xls*", , , , True)
j = 0      '初始值设置
k = 0
p = 0
For i = LBound(str) To UBound(str)
        Set wb = Workbooks.Open(str(i))      
        m = Application.WorksheetFunction.Match("消费交易", wb.Sheets(2).Range("a1:a100"), 0)            '定位有效数据行数-银行卡表
        n = Application.WorksheetFunction.Match("消费交易", wb.Sheets(3).Range("a1:a100"), 0)            '定位有效数据行数-扫码明细表

        '银行卡表A-S列有效数据复制粘贴到目标工作表最后一行
        wb.Sheets(2).Range("a" & m + 1 & ":S" & wb.Sheets(2).Range("e65536").End(xlUp).Row).Copy wb1.Sheets(2).Range("a" & j + 1)

        '扫码明细表A—Q列有效数据复制粘贴到目标工作表最后一行
        wb.Sheets(3).Range("a" & n + 1 & ":Q" & wb.Sheets(3).Range("e65536").End(xlUp).Row).Copy wb1.Sheets(3).Range("a" & k + 1)

        '其他费用明细表A—Q列有效数据复制粘贴到目标工作表最后一行
        wb.Sheets(4).Range("a2:E" & wb.Sheets(4).Range("e65536").End(xlUp).Row).Copy wb1.Sheets(4).Range("a" & p + 1)

        wb.Close

        j = wb1.Sheets(2).Range("a65536").End(xlUp).Row '合并区域最后一行的行数
        k = wb1.Sheets(3).Range("a65536").End(xlUp).Row
        p = wb1.Sheets(4).Range("a65536").End(xlUp).Row

Next
Application.ScreenUpdating = True  '恢复运算演示
MsgBox "合并完成"
End Sub