excel技巧-利用VBA合并工作表与工作薄.docx

1. 合并Excel文件打开一个空Excel文件，Alt+F11，插入一个模块，开始写代码吧：Sub MergeWorkbooks() Dim FileSet Dim i As Integer On Error GoTo 0Application.ScreenUpdating = FalseFileSet = Application.GetOpenFilename(FileFilter:=Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx, _MultiSelect:=True, Title:=选择要合并的文件) If TypeName(FileSet) = Boolean ThenGoToExitSub End If For Each Filename InFileSetWorkbooks.Open FilenameSheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) NextExitSub:Application.ScreenUpdating = TrueEnd Sub2. 合并工作表同上，再添加一个模块吧，代码如下Function LastRow(sh As Worksheet) On Error Resume NextLastRow = sh.Cells.Find(what:=*, _ After:=sh.Range(A1), _Lookat:=xlPart, _LookIn:=xlFormulas, _SearchOrder:=xlByRows, _SearchDirection:=xlPrevious, _MatchCase:=False).Row On Error GoTo 0End FunctionSub MergeSheets() Dim sh As Worksheet Dim DestShAs Worksheet Dim Last As Long Dim shLast As Long Dim CopyRngAs Range Dim StartRowAs LongApplication.ScreenUpdating = FalseApplication.EnableEvents = False 新建一个“汇总”工作表Application.DisplayAlerts = False On Error Resume NextActiveWorkbook.Worksheets(汇总).Delete On Error GoTo 0Application.DisplayAlerts = True Set DestSh = ActiveWorkbook.Worksheets.AddDestSh.Name = 汇总 开始复制的行号，忽略表头，无表头请设置成1StartRow = 1 For Eachsh In ActiveWorkbook.Worksheets If sh.Name DestSh.Name Then Last = LastRow(DestSh)shLast = LastRow(sh) If shLast 0 AndshLast = StartRow Then Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) If Last + CopyRng.Rows.Count DestSh.Rows.Count ThenMsgBox 内容太多放不下啦！GoToExitSub End IfCopyRng.Copy With DestSh.Cells(Last + 1, A) .PasteSpecialxlPasteValues .PasteSpecialxlPasteFormatsApplication.CutCopyMode = False End With End If End If NextExitSub:Application.GoToDestSh.Cells(1)DestSh.Columns.AutoFitAp