上次我们分享多表格合并为一个表格，并且说了这个过程主要分为两步，①多个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
