excel 根据工作表某列拆分成多个工作表

Sub 根据工作表某列拆分成多个工作表()
Dim Con As Object
Dim Sql$
Dim I%
Dim Re As Object
Dim Arr As Variant

Set Con = CreateObject("Adodb.Connection")
With Con
.Open "Provider=Microsoft.jet.oledb.4.0;Extended properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
Sql = "Select [管理地] from [表名称$] Group By [管理地]" '管理地为所区分的字段名称，表名称为工作表名，注意使用时要修改“管理地”和“表名称”。
Set Re = .Execute(Sql)
Arr = Application.Transpose(Re.getrows)
For I = 1 To UBound(Arr)
Sql = "Select * into C:\" & Arr(I, 1) & ".创建 From [表名称$] Where [管理地]='" & Arr(I, 1) & "'"
.Execute Sql
Next
Shell "Explorer C:\", vbMaximizedFocus
.Close
Set Re = Nothing
Set Con = Nothing
End With
End Sub

'第一行复制一次，再插入，也就是形成了两个标题，这样的原理只是新建的表有标题而已