如何将一个表格内的多个sheet拆分成多个

Question

如题所述

Answer 1

以WPS 2019版本为例：

关于如何将一个表格内的多个sheet拆分成多个，您可使用WPS参考下述步骤完成操作：

1、打开「表格（Excel）」文档；

2、点击「数据-拆分表格」；

3、按需选择「把工作表按照内容拆分」或「把工作簿按照工作表拆分」使用即可。

Answer 2

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Dim ws As Worksheet
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sm = Application.SheetsInNewWorkbook
For Each ws In Worksheets
With ws
Set rng = Nothing
Set rng = .UsedRange.Find(what:="理财中心", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not rng Is Nothing Then
r0 = rng.Row
c0 = rng.Column
r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
If r > r0 Then
arr = .Cells(1, c0).Resize(r, 1)
For i = r0 + 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
End If
If Not d(arr(i, 1)).exists(ws.Name) Then
Set d(arr(i, 1))(ws.Name) = .Range("a1").Resize(r0, c)
End If
Set d(arr(i, 1))(ws.Name) = Union(d(arr(i, 1))(ws.Name), .Cells(i, 1).Resize(1, c))
Next
End If
End If
End With
Next
For Each aa In d.keys
Application.SheetsInNewWorkbook = d(aa).Count
Set wb = Workbooks.Add
m = 0
With wb
For Each bb In d(aa).keys
m = m + 1
With .Worksheets(m)
.Name = bb
d(aa)(bb).Copy .Range("a1")
End With
Next
.SaveAs Filename:=ThisWorkbook.Path & "\" & aa & ".xls"
.Close False
End With
Next
Application.SheetsInNewWorkbook = sm
End Sub本回答被提问者采纳

Answer 3

上网查询吧