上次我们分享多表格合并为一个表格，并且说了这个过程主要分为两步，①多个Excel表合并到一个EXCEL表的多个sheet；②一个Excel表的多个sheet合并到同一个sheet里面。①我们已经分享，今天我们分享一下怎么把一个Excel表里的多个sheet合并到同一个sheet里面，依然需要用代码，把多次重复的工作交给机器去完成。

执行代码为

Sub 合并工作表()

Dim NewSht As Worksheet, ActiveWb As Workbook

Set ActiveWb = ActiveWorkbook '将活动工作簿赋值给变量ActiveWb

Set NewSht = Workbooks.Add.Sheets(1) '新建一个工作簿，将它的第1个工作表赋值给变量NewSht(此时活动工作簿不再是ActiveWb所代表的工作簿了)

'声明一个Worksheet型变量Sht,用于For Each...Next循环语句的变量，以及一个Integer型的变量，作为计数器使用，代表被合并的工作表数量

Dim Sht As Worksheet, i As Integer

For Each Sht In ActiveWb.Worksheets '遍历ActiveWb的每一个工作表(使用Worksheets而不是Sheets，会跳过图表)

i = i + 1 '累加变量

Sht.UsedRange.Copy '复制sht工作表的已用数据区域

'如果变量i的值等于1，那么取工作表NewSht的B1赋值给变量rng，否则取B列最后一个非空单元格的下一个单元格赋值给变量rng，此变量为粘贴复制单元格的开始位置

Set rng = IIf(i = 1, Range("B1"), NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0))

rng.PasteSpecial Paste:=xlPasteFormats '选择性粘贴格式

rng.PasteSpecial Paste:=xlPasteColumnWidths '选择性粘贴列宽

rng.PasteSpecial Paste:=xlPasteValues '选择性粘贴数值

rng.Offset(0, -1).Resize(Sht.UsedRange.Rows.Count, 1).Merge '合并首列

rng.Offset(0, -1) = Sht.Name '将原工作表名称写入合并单元格

Next Sht

'如果变量i大于0，那么将A列的非空单元格添加边框

If i > 0 Then Application.Intersect(Range("a:a"), NewSht.UsedRange).Borders.LineStyle = xlContinuous

End Sub

​