EXCEL代码记录

将一页sheet内容拆分为多页

Sub test()
Application.ScreenUpdating = False
Set d = CreateObject(“scripting.dictionary”)
arr = Sheets(1).UsedRange
For j = 2 To UBound(arr)
If d.exists(arr(j, 2)) Then
Set d(arr(j, 2)) = Union(d(arr(j, 2)), Cells(j, 1))
Else
Set d(arr(j, 2)) = Union([a1], Cells(j, 1))
End If
Next j
For j = 0 To d.Count - 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = d.keys()(j)
d.items()(j).EntireRow.Copy Sheets(Sheets.Count).[a1]
Next j
Application.ScreenUpdating = True
End Sub

将多页sheet拆为多个Excel

查看代码>插入>模块>双击模块
Private Sub 分拆工作表()
Dim sht As Worksheet
Dim Mybook As Workbook
Set Mybook = ActiveWorkbook
For Each sht In Mybook.Sheets
sht.Copy
ActiveWorkbook.SaveAs Filename:=Mybook.Path & “” & sht.Name, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Next
MsgBox “文件已经被拆分完毕”
End Sub

注：有时候复制到EXCEL会发生符号变化，英文双引号变中文双引号，导致运行失败，如果失败可检查一下符号问题

批量修改sheet名称

将所有sheet准备好，所有命名放在第一页sheet第一列
查看代码>插入>模块>双击模块
Sub 重命名()
Dim i&
For i = 2 To Sheets.Count
Sheets(i).Name = Sheets(1).Cells(i, 1)
Next
End Sub