'工作表打开，开始合并工作表当前目录下的所有工作表Private Sub Workbook_Open() Dim sh As Worksheet '定义变量名 Dim StartRow As Long Dim LastRow As LongApplication.ScreenUpdating = FalseApplication.EnableEvents = False p = ThisWorkbook.Path & "/" f = Dir(p & "*.xls") m = ThisWorkbook.Name Call inti '调用初始化模块 Do While f <> "" And f <> m '用一个DO LOOP循环打开复制工作表的内容到当前工作表中 Workbooks.Open p & f Set sh = ActiveWorkbook.Sheets(1) '设置对象 StartRow = 2 '设置复制首行 LastRow = sh.[B65536].End(xlUp).Row '设置复制末行 sh.Range(sh.Rows(StartRow), sh.Rows(LastRow)).Copy Workbooks(m).Sheets(1).[a65536].End(xlUp).Offset(1, 0) '复制过程，假设A列为填入单元 ActiveWorkbook.Saved = True ActiveWindow.Close Set sh = Nothing '释放对象 f = Dir Loop Application.GoTo Workbooks(m).Sheets(1).Cells(1) '跳转到当前工作薄的第一个单元格 Application.ScreenUpdating = True Application.EnableEvents = TrueEnd SubPrivate Sub inti()ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion.Offset(1, 0).Clear '初始当前工作薄不变的内容End Sub
