多个excel工作簿汇总，同一工作簿中sheets合并

工作中经常会用到的把几个 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 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 = 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
   Next

ExitSub:
   Application.GoTo DestSh.Cells(1)
   DestSh.Columns.AutoFit
   Application.ScreenUpdating = True
   Application.EnableEvents = True

End Sub

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

3.按需合并工作表

在EXCEL中打开宏，将下列代码进行粘贴并保存。然后返回你需要合并的工作表中，运行此宏，看看效果吧。

Sub 合并sheets()
    n = 12 '源表个数，根据需要修改！
    nstart = 9 '每个单表数据的开始行数，根据需要修改！
    k = nstart '目标表的行标
    For i = 1 To n
        irow = nstart '行标
        While Sheets(i).Cells(irow + 1, 2) <> "" '后面个1以第2列数据的最后1行是空作为行结束标示,确定源表的行数，根据需要修改！
            irow = irow + 1
        Wend
        Sheets(i).Rows(nstart & ":" & irow).Copy '复制源数据行
        Sheets(n + 1).Activate
        Sheets(n + 1).Cells(k, 1).Select
        ActiveSheet.Paste '粘贴数据
        k = k + irow - nstart + 1
    Next i
End Sub