把一个目录下的excel整合到一个文件中.doc

操作要求： 首先建立一个目录，将想要合并的表格放入到目录里，然后新建一个Excel文件--》打开--》Alt+F11--》插入模块--》将下面的程序考入--》然后回到文件里运行！ 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 Lett 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 Nothing End Sub 2、用microsoft excel打开新建的excel表，并右键单击sheet1，找到“查看代码”，单击进去。进去之后就看到了宏计算界面。 Sub 合并当前目录下所有工作簿的全部工作表 Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating False MyPath ActiveWorkbook.Path MyName Dir MyPath \ *.xls AWbName ActiveWorkbook.Name Num 0 Do While MyName If MyName AWbName Then Set Wb Workbooks.Open MyPath \ MyName Num Num + 1 With Workbooks 1 .ActiveSheet .Cells .Range B65536 .End xlUp .Row + 2, 1 Left MyName, Len MyName - 4 For G 1 To Sheets.Count Wb.Sheets G .UsedRange.Copy .Cells .Range B65536 .End xlUp .Row + 1, 1 Next WbN WbN Chr 13 Wb.Name Wb.Close False End With End If MyName Dir Loop Range B1 .Select Application.ScreenUpdating True MsgBox 共合并了 Num 个工作薄下的全部工作表。如下： Chr 13 WbN, vbInformation, 提示 End Sub