在实际工作中,有时需要将一个工作簿中的每个工作表都另存为单独的工作簿以方便发给不同的人。本例介绍如何用VBA代码快速完成该过程。
首先看一下原始数据表,在这个工作簿中每个工作表分别存储了一个人的数据。现在需要将每个人的工作表单独存成excel工作簿文件。
首先,按键盘上的Alt+F11进入VBA代码编辑界面。
根据图示,在工作簿中插入一个模块。
在模块内粘贴下述代码: Sub SaveAs() On Error Resume Next Dim FolderPath As String, FolderName As String, BN As String Dim ReturnValue As Integer BN = ActiveWorkbook.Name FolderPath = ThisWorkbook.Path FolderName = Mid(BN, 1, InStrRev(BN, ".", Len(BN)) - 1) Dim MyFile As Object Set MyFile = CreateObject("Scripting.FileSystemObject") If MyFile.folderexists(FolderPath & "\" & FolderName & "-Saved") Then ReturnValue = MsgBox("文件夹已存在,是否更新内容?", vbOKCancel, "Caution!") If ReturnValue = 2 Then Exit Sub Else MyFile.CreateFolder (FolderPath & "\" & FolderName & "-Saved") Set MyFile = Nothing End If Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i As Integer For i = 1 To Sheets.Count Set Wk = Workbooks.Add Workbooks(BN).Sheets(i).Copy before:=Wk.Worksheets("Sheet1") Wk.SaveAs FolderPath & "\" & Fold