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

1. 合并 Excel 文件 打开一个空 Excel 文件， Alt+F11 ，插入一个模块，开始写代码吧： Sub MergeWorkbooks() Dim FileSet Dim i As Integer On Error GoTo 0 Application.ScreenUpdating = False FileSet = Application.GetOpenFilename(FileFilter:=Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx, _ MultiSelect:=True, Title:= 选择要合并的文件 ) If TypeName(FileSet) = Boolean Then GoTo ExitSub End If For Each Filename In FileSet Workbooks.Open Filename Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next ExitSub: Application.ScreenUpdating = True End Sub 合并工作表 同上，再添加一个模块吧，代码如下 Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(what:=*, _ After:=sh.Range(A1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub MergeSheets() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long Application.ScreenUpdating = False Application.EnableEvents = False 新建一个“汇总”工作表 Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets( 汇总 ).Delete On Error GoTo 0 Application.DisplayAlerts = True Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = 汇总 开始复制的行号，忽略表头，无表头请设置成 1 StartRow = 1 For Each sh In ActiveWorkbook.Worksheets If sh.Name DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) If shLast 0 And shLast = StartRow Then Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox 内容太多放不下啦！ GoTo ExitSub End If CopyRng.Copy With DestSh.Cells(Last + 1, A) .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If End If Next ExitSub: Application.GoTo DestSh.Cells(1) DestSh.Columns.AutoFit Application.ScreenUpdating = True Application.EnableEvents = True End Sub EXCEL ：一个工作薄中多个工作表合并代码 在 EXCEL 中打开宏，将下列代码进行粘贴并保存。然后返回你需要合并的工作表中，运行此宏，看看效果吧。 Sub 合并 sheets() n = 12 源表个数，根据需要修改！