Excel-VBA把工作薄中的工作表拆分独立工作薄

应用场景把工作薄的工作表拆分为独立的工作薄

知识要点

1：Application.FileDialog(msoFileDialogFolderPicker) 通过

对话框选择存放路径2：Workbook.SaveAs 方法在另一不

同文件中保存对工作簿所做的更改。3：.Find('*]*'!' 查找工

作表中是否存在外部引用，如有则转换为值

4：Sheets.Copy(Before, After) 方法将工作表复制到工作簿

的另一位置,如果既不指定Before 也不指定After，则将新

建一个工作簿，其中包含复制的工作表。5：Shell 函数执

行一个可执行文件Shell 'EXPLORER.EXE' 用EXPLORER.EXE 打开文件夹6：explorer.exe是Windows

程序管理器或者文件资源管理器，它用于管理Windows图

形壳，包括桌面和文件管理Sub 把工作薄拆分为单个工作

表() On Error Resume Next Dim Pathstr As String, i As Long, Activewb As String, Cell As Range, Firstaddress As String With

Application.FileDialog(msoFileDialogFolderPicker) '

创建文件对话框的实例If .Show Then '如果在对话框中单击了确定按钮Pathstr =

.SelectedItems(1) '将选定的路径赋予变量Else

Exit Sub End If End With Pathstr = Pathstr

& IIf(Right(Pathstr, 1) = '\', '', '\') '如果不是\，末尾添加\ Application.ScreenUpdating = False Activewb = https://www.360docs.net/doc/089588043.html, '记录活动工作薄名For i = 1 To Sheets.Count '循环所有工作表Sheets(i).Copy '复制

工作表到新工作薄中(忽略了参数) '将工作薄另存，

文件名由工作表觉得，而文件的后缀名则由excel程序的版

本决定ActiveWorkbook.SaveAs Filename:=Pathstr

& Workbooks(Activewb).Sheets(i).Name &

IIf(Application.Version * 1 < 12, '.xls', '.xlsx'),

FileFormat:=xlWorkbookDefault, CreateBackup:=False

With https://www.360docs.net/doc/089588043.html,edRange '引用已用区域'查

找“=*]*'!”,也就是检查是否存在外部引用Set Cell = .Find('*]*'!', LookIn:=xlFormulas,

searchorder:=xlByRows, lookat:=xlPart, MatchCase:=True) If Cell Is Nothing Then GoTo Line Firstaddress = Cell.Address '记录第一个找到的地址Do Cell = Cell.Value '将公式转换为数值

Set Cell = .FindNext(Cell) '查找下一个If

Cell Is Nothing Then Exit Do '如果未找到，退出循环

If Cell.Address = Firstaddress Then Exit Do Loop End WithLine: ActiveWindow.Close '关闭窗口

Workbooks(Activewb).Activate '激活待拆分的工作薄

Next i Application.ScreenUpdating = True Shell

'EXPLORER.EXE' & Pathstr, vbNormalFocus '打开文件夹End Sub