zhy_nalu zhy_nalu
关注数: 8 粉丝数: 91 发帖数: 1,574 关注贴吧数: 14
求助,关于拆分EXCEL工作簿,然后命名的问题 大家好,我刚刚接触VBA,请大神不要笑话。 在本贴吧找了一段代码,功能是,在当前文件夹下,拆分所有工作簿的工作表,然后按照工作簿名字当文件夹名称,工作表名字当新的工作簿名称,保存在对应文件夹下。 举例: 工作簿年终奖XLSX,包含工作表:科室A,科室B,科室C。 拆分以后,变成: 年终奖(文件夹名) |---科室A(工作簿名) |---科室B(工作簿名) 我现在的需求是,能不能命名新的工作簿名称的时候,采用原工作簿名字+工作表的格式, 例如前面的例子,拆分以后,保存的时候,变成这样的: 年终奖(文件夹名) |---年终奖-科室A(工作簿名) |---年终奖-科室B(工作簿名) ----------------------------- 源代码如下: Sub 拆分为独立工作薄() Application.ScreenUpdating = False Dim wb As Excel.Workbook Dim sh As Excel.Worksheet t = Timer Set fso = CreateObject("scripting.filesystemobject") f = Dir(ThisWorkbook.Path & "\*.xls*") '生成查找EXCEL的目录,可以适应不同版本 Do While f <> "" '在目录中循环 If f <> ThisWorkbook.Name Then '如果不是打开的工作簿 Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f) '依次打开目录工作薄 If fso.folderexists(ThisWorkbook.Path & "\" & Split(wb.Name, ".")(0)) Then fso.deletefolder ThisWorkbook.Path & "\" & Split(wb.Name, ".")(0) MkDir ThisWorkbook.Path & "\" & Split(wb.Name, ".")(0) For Each sh In wb.Worksheets '在打开的工作薄的工作表中循环 sh.Copy '拷贝工作表为工作薄 ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Split(wb.Name, ".")(0) & "\" & sh.Name & ".xlsx" '工作表保存为工作薄 ActiveWorkbook.Close '关闭新建立的工作薄 Next wb.Close False '关闭打开的工作薄 End If f = Dir Loop '结束循环 MsgBox "ok!耗时" & Format(Timer - t, "00") & "秒" Application.ScreenUpdating = True End Sub 我知道,关键的代码是这一行: ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Split(wb.Name, ".")(0) & "\" & sh.Name & ".xlsx" '工作表保存为工作薄 但是,如何改成我前面提到的那种,最终新的工作簿,命名的时候,是用原始工作簿+工作表的格式生成文件?
1 下一页