通过VBA宏合并Excel工作表

工作中经常会用到的把几个Excel文件合并到一个，或者是把一个Excel文件里的所有Sheet合并到一个Sheet来进行统计。下面分别提供用vba宏来解决这两个问题的方法。

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

这段代码的作用：它首先打开一个文件选择框，你可以选择一个或多个文件，然后把这些文件里的所有Sheet合并到当前这个工作簿里来，有重名的Sheet会自动在后面加数字。

2、合并一个EXCEL多个sheet的内容到一个汇总sheet

同上，再添加一个模块吧，代码如下：

 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 0End FunctionSub 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 = 2 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 NextExitSub: Application.GoTo DestSh.Cells(1) DestSh.Columns.AutoFit Application.ScreenUpdating = True Application.EnableEvents = True End Sub

这段代码的作用：它会新建一个叫做“汇总”的工作表，然后把当前工作簿里的所有Sheet里有数据的内容都复制到“汇总”表里。提示：如果数据表里的内容没有表头的话需要把StartRow = 2改成StartRow = 1。