拆分sheet和合并sheet

1.拆分sheet
按照某列拆分sheet两种形式：
（1）数据透视表：
选定本工作表区域
筛选器：待分类列；行分类：剩下列
设置：数据透视表工具设计中选择：
分类汇总：不显示分类汇总
总计：对行和列禁用
报表布局：以表格形式显示
拆分：全选数据透视表数据，选项中选择显示报表筛选项，确定
（2）VBA方式

#分类拆分sheet.name需要修改为当前表的名字
#第一个弹框选择表头
#第二个弹框选择分类列名
Sub chaifen()
    Dim myRange As Variant
    Dim myArray
    Dim titleRange As Range
    Dim title As String
    Dim columnNum As Integer
    myRange = Application.InputBox(prompt:="第一行：", Type:=8)
    myArray = WorksheetFunction.Transpose(myRange)
    Set titleRange = Application.InputBox(prompt:="选择某列", Type:=8)
    title = titleRange.Value
    columnNum = titleRange.Column
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i&, Myr&, Arr, num&
    Dim d, k
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "测试" Then
            Sheets(i).Delete
        End If
    Next i
    Set d = CreateObject("Scripting.Dictionary")
    Myr = Worksheets("测试").UsedRange.Rows.Count
    Arr = Worksheets("测试").Range(Cells(2, columnNum), Cells(Myr, columnNum))
    For i = 1 To UBound(Arr)
        d(Arr(i, 1)) = ""
    Next
    k = d.keys
    For i = 0 To UBound(k)
        Set conn = CreateObject("adodb.connection")
        conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
        Sql = "select * from [测试$] where " & title & " = '" & k(i) & "'"
        Worksheets.Add after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = k(i)
            For num = 1 To UBound(myArray)
                .Cells(1, num) = myArray(num, 1)
            Next num
            .Range("A2").CopyFromRecordset conn.Execute(Sql)
        End With
        Sheets(1).Select
        Sheets(1).Cells.Select
        Selection.Copy
        Worksheets(Sheets.Count).Activate
        ActiveSheet.Cells.Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    conn.Close
    Set conn = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

2.合并工作表

##该代码适用于A列最后一行有值，获取汇总表已使用单元格行数时最好使用必填单元格，否则可能会出现覆盖的情况
##若每个工作表都有表头，则表头会出现重复
##第一行会存在空行，是由获取下一行造成的
Sub Merge() '工作簿内合并所有工作表 
	Dim sheetsCount As Long '当前工作表数量 
	Dim rowCount As Long '汇总后表行数 
	Dim i As Long '循环i次
	With ThisWorkbook 
		sheetsCount = .Sheets.Count '获取当前工作表数量 
		.Sheets.Add After:=.Sheets(.Sheets.Count) '新建一个工作表
		.Sheets(.Sheets.Count).Name = "汇总" '新建工作表名汇总 
		For i = 1 To sheetsCount 
			.Sheets(i).UsedRange.Copy '逐个循环复制表内
			With .Sheets("汇总") 
				rowCount = .Range("B" & 2 ^ 20).End(xlUp).Row + 1 '获取汇总表下一行行数，B列值不为空，选择B列作为计算列
				.Range("A" & rowCount).Select '选中A列该行所在单元格 
				.Paste '粘贴 
			End With 
		Next
		.Sheets("汇总").Move before:=.Sheets(1) '移动汇总表 
	End With 
End Sub