合并不同工作簿中数据至同一工作簿中

很明显的要求待合并工作簿中的数据格式统一,并且放置在第1个工作表中(是不是要求太高?!)

以前也写过一个代码,但代码运行时间太长,40个班的数据大约需要5分钟的时间,而这段代码大约只需要10秒钟的时间.

Option Explicit

Sub 合并不同工作簿中的数据至同一工作簿中()
    '利用工作簿对象及数组来实现
    '不知道利用单元格对象能否实现.
    '清除掉目标工作表的数据,只保留标题行
    Worksheets("成绩").Activate
    Range("2:65536").Clear
    
    '借助工作簿对象实现合并
    Dim fileName As String, myRng As Range, Wb As Workbook, Ws As Worksheet
    
    fileName = Dir(ThisWorkbook.Path & "\班级成绩表\*.xls")
    Debug.Print fileName '返回的只是文件名,不包含路径,所以下面必须添加路径名

    
    Application.ScreenUpdating = False
    Do While fileName <> ""
        Set myRng = Range("A65536").End(xlUp).Offset(1, 0)
        Set Wb = GetObject(ThisWorkbook.Path & "\班级成绩表\" & fileName)
        Set Ws = Wb.Worksheets(1) '保证数据放在第1张工作表中
        With Ws
            .Range("A2").Resize(.Range("A65536").End(xlUp).Row - 1, .Range("IV1").End(xlToLeft).Column).Copy myRng
        End With
        Wb.Close False
        '为什么set wb=nothing不行呢?因为已经打开对象,nothing只是注销对象,并不是
        '关闭已经打开的对象,所以必须用close false语句关闭.
       
        fileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

下一步想实现脱离原文件,现在的代码必须附着在目标工作簿中,想着如果可以把源程序放在单独文件中, 这样可以省更多的事,现在时间太晚了,明天做这个.