多个excel工作簿汇总，同一工作簿中sheets合并
<pre><code> 多个excel工作簿汇总，同一工作簿中sheets合并
标签： vbaexcel 2007数据宏
2014-08-06 11:45 1701人阅读 评论(0) 收藏 举报
分类： Excel&amp;Sql（4）
[vb] view plain copy
工作中经常会用到的把几个Excel文件合并到一个，或者是把一个Excel文件里的所有Sheet合并到一个Sheet来进行统计。下面分别提供用vba宏来解决这两个问题的方法。
1、合并Excel文件
打开一个空Excel文件，Alt+F11，插入一个模块，开始写代码：
[vb] view plain copy
Sub MergeWorkbooks()
Dim FileSet
Dim i As Integer
On Error GoTo 0
Application.ScreenUpdating = False
FileSet = Application.GetOpenFilename(FileFilter:=&quot;Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx&quot;, _
MultiSelect:=True, Title:=&quot;选择要合并的文件&quot;)
If TypeName(FileSet) = &quot;Boolean&quot; 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
同上，再添加一个模块吧，代码如下：
[vb] view plain copy
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(what:=&quot;*&quot;, _
After:=sh.Range(&quot;A1&quot;), _
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(&quot;汇总&quot;).Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = &quot;汇总&quot;
'开始复制的行号，忽略表头，无表头请设置成1
StartRow = 2
For Each sh In ActiveWorkbook.Worksheets
If sh.Name &lt;&gt; DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
If shLast &gt; 0 And shLast &gt;= StartRow Then
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
If Last + CopyRng.Rows.Count &gt; DestSh.Rows.Count Then
MsgBox &quot;内容太多放不下啦！&quot;
GoTo ExitSub
End If
CopyRng.Copy
With DestSh.Cells(Last + 1, &quot;A&quot;)
.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) &lt;&gt; &quot;&quot; '后面个1以第2列数据的最后1行是空作为行结束标示,确定源表的行数，根据需要修改！
irow = irow + 1
Wend
Sheets(i).Rows(nstart &amp; &quot;:&quot; &amp; irow).Copy '复制源数据行
Sheets(n + 1).Activate
Sheets(n + 1).Cells(k, 1).Select
ActiveSheet.Paste '粘贴数据
k = k + irow - nstart + 1
Next i
End Sub</code></pre>