一看就会，一写就废的案例，这儿有一个。

Sub 循环打开工作簿()    Application.DisplayAlerts = False    Application.ScreenUpdating = False    Application.AskToUpdateLinks = False    Dim wb As Workbook    col = 2    Set hz = Worksheets("汇总结果") '把汇总结果sheet赋值给对象变量hz    hz.Cells.clear '清除上次结果    myname = Dir(ThisWorkbook.Path & "\" & "*.xls*") 'Dir函数首次获取代码工作簿路径下的文件名    Do While myname <> "" 'Do While循环会一直运行，只到myname变量是空值        If myname <> ThisWorkbook.Name Then            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & myname)              wb.ActiveSheet.Range("a6:a27").Copy hz.Range("a2") '复制标题列              wb.ActiveSheet.Range("b6:b27").Copy hz.Cells(2, col) '复制数据列              hz.Cells(1, col) = Replace(Replace(myname, ".xlsx", ""), ".xls", "") '替换后缀为空，获取文件名              col = col + 1 '列号+1，为了下一次写入文件名            wb.Close False '关闭打开的日报表工作簿，并且不保存         End If        myname = Dir 'Dir函数再次获取代码工作簿路径下的文件名    Loop    hz.Columns.AutoFit '汇总结果表，列自动适配列宽    hz.Select '激活汇总结果表    Application.DisplayAlerts = True    Application.ScreenUpdating = True    Application.AskToUpdateLinks = True    MsgBox "汇总完成！"End SubSub clear() Set hz = Worksheets("汇总结果") hz.Cells.clear MsgBox "已清除上次结果"End Sub