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 ＆amp； IIf(Right（Pathstr， 1） = ’\'， '’， '\'） ’假如不是\，末尾添加\ Application.ScreenUpdating = False Activewb = ActiveWorkbook.Name '记录活动工作薄名 For i = 1 To Sheets。Count '循环所有工作表 Sheets（i）。Copy ’复制工作表到新工作薄中（忽略了参数) ’将工作薄另存，文件名由工作表觉得，而文件的后缀名则由 excel 程序的版本决定 ActiveWorkbook。SaveAs Filename：=Pathstr &； Workbooks(Activewb)。Sheets(i)。Name ＆amp； IIf（Application。Version * 1 ＆lt； 12, '.xls', '.xlsx')， FileFormat：=xlWorkbookDefault， CreateBackup:=False With ActiveSheet。UsedRange ’引用已用区域 ’查找“=＊]*'!”,也就是检查是否存在外部引用 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’ ＆amp； Pathstr， vbNormalFocus '打开文件夹 End Sub
