合并EXCEL工作簿中表格(sheet)的三种情况教程及代码.doc

一、操作方法将所有要合并的工作簿存放到同目录下，在同目录下新建“汇总工作簿.xls”,打开后，按Alt+F11进入代码编辑界面,点击插入-模块，将代码复制粘贴进去，点击运行。二、将多个工作簿的所有工作表(sheet)复制到一个工作簿内,代码：Sub CombineFiles() Dim path As String Dim FileName As String Dim LastCell As Range Dim Wkb As Workbook Dim WS As Worksheet Dim ThisWB As String Dim MyDir As String MyDir = ThisWorkbook.path & ChDrive Left(MyDir, 1) find all the excel files ChDir MyDir Match = Dir$() ThisWB = ThisWorkbook.Name Application.EnableEvents = False Application.ScreenUpdating = False path = MyDir FileName = Dir(path & *.xls, vbNormal) Do Until FileName = If FileName ThisWB Then Set Wkb = Workbooks.Open(FileName:=path & & FileName) For Each WS In Wkb.Worksheets Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) If LastCell.Value = And LastCell.Address = Range($A$1).Address Then Else WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If Next WS Wkb.Close False End If FileName = Dir() Loop Application.EnableEvents = True Application.ScreenUpdating = True Set Wkb = Nothing Set LastCell = NothingEnd Sub三、将多个工作簿的第一张工作表（sheet）复制到一个工作簿内,代码：Private Sub 合并工作薄() Dim f_name As String Dim bok1 As Workbook, bok2 As Workbook Set bok2 = Nothing f_name = Dir(ThisWorkbook.Path & *.*) 获得该目录下的所有EXCEL文件 Do While f_name 开始执行循环 If f_name ThisWorkbook.Name Then 如果当前的文件不是代码所在文件，执行合并操作 Set bok1 = Workbooks.Open(ThisWorkbook.Path & & f_name) 打开被合并的文件 If bok2 Is Nothing Then 合并后的文件是否存在 bok1.Sheets(1).Copy 如果合并后的文件不存在，则创建一个 Set bok2 = ActiveWorkbook Else bok1.Sheets(1).Copy Before:=bok2.Sheets(1) 如果合并后的文件存，在则将被合并文件的第一个工作表复制到合并文件中。 End If bok1.Close 关闭被合并文件 End If f_name = Dir() 获取下一个被合并文件名 Loop End Sub四、将多个工作簿的所有工作表（sheet）复制到一个工作簿的同一个sheet内,代码：Sub 合并当前目录下所有工作簿的全部工作表()Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & & *.xls)AWbName = ActiveWorkbook.NameNum = 0Do While MyName If MyName AWbName ThenSet Wb = Workbooks.Open(MyPath & & MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range(A65536).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range(A65536).End(xlUp).Row + 1, 1)NextWbN = WbN & Chr(13) & Wb.NameWb.Close FalseEnd WithEnd IfMyName = DirLoopRange(