博客列表 >EXCEL将各个Sheet工作表另存为新工作簿

EXCEL将各个Sheet工作表另存为新工作簿

Coco
Coco原创
2021年12月19日 22:32:111896浏览

  通过EXCEL中的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:=Wksheets("Sheet1")

  Wk.SaveAs FolderPath & "" & FolderName & "-Saved" & ThisWorkbook.Sheets(i).Name

  Wk.Close

  Next i

  Application.DisplayAlerts=True

  Application.ScreenUpdating=True

  End Sub

声明:本文内容转载自脚本之家,由网友自发贡献,版权归原作者所有,如您发现涉嫌抄袭侵权,请联系admin@php.cn 核实处理。
全部评论
文明上网理性发言,请遵守新闻评论服务协议