使用VBA宏将每个Excel工作表保存为单独的工作簿

问题描述

我正在尝试使用这个代码将每张Excel表保存到新的工作簿中。但是，它将整个工作簿保存到新的文件名。

  Dim path As String 
 Dim dt As String 
 dt = Now（）
 path = CreateObject（WScript.Shell）。specialfolders（Desktop）& \Cendendars&替换（替换（dt，：，。），/，。）
 MkDir路径
调用Shell（explorer.exe&& path，vbNormalFocus ）
 
 Dim ws As Worksheet 
对于每个ws在ThisWorkbook.Worksheets的SetVersions 
如果ws.name<> How-To和ws.name<> Actg_Prd然后
 ws.SaveAs path& ws.name，xlsx 
结束如果
下一个ws 
  

什么是快速修复？

解决方案

将工作表保存在现有工作簿中，并使用副本创建新的工作簿

  Dim path As String 
 Dim dt As String 
 dt = Now（）
 path = CreateObject（WScript.Shell ）。特殊文件夹（桌面）& \Cendendars&替换（替换（dt，：，。），/，。）
 MkDir路径
调用Shell（explorer.exe&& path，vbNormalFocus ）
 
 Dim ws As Worksheet 
对于每个ws在ThisWorkbook.Worksheets的SetVersions 
如果ws.Name<> How-To和ws.Name<> Actg_Prd然后
 Dim wb As Workbook 
设置wb = ws.Application.Workbooks.Add 
 ws.Copy之前：= wb.Sheets（1）
 wb.SaveAs路径&安培; ws.Name，Excel.XlFileFormat.xlOpenXMLWorkbook 
设置wb =没有
结束如果
下一个ws 
  

Hi I am trying to use this code to save each sheet of Excel to a new workbook. However, it is saving the entire workbook to the new filename

Dim path As String
Dim dt As String
dt = Now()
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Calendars " & Replace(Replace(dt, ":", "."), "/", ".")
MkDir path
Call Shell("explorer.exe" & " " & path, vbNormalFocus)

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'SetVersions
    If ws.name <> "How-To" And ws.name <> "Actg_Prd" Then
        ws.SaveAs path & ws.name, xlsx
    End If
Next ws

What is the quick fix?

解决方案

Keeping the worksheet in the existing workbook and creating a new workbook with a copy

Dim path As String
Dim dt As String
dt = Now()
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Calendars " & Replace(Replace(dt, ":", "."), "/", ".")
MkDir path
Call Shell("explorer.exe" & " " & path, vbNormalFocus)

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'SetVersions
    If ws.Name <> "How-To" And ws.Name <> "Actg_Prd" Then
        Dim wb As Workbook
        Set wb = ws.Application.Workbooks.Add
        ws.Copy Before:=wb.Sheets(1)
        wb.SaveAs path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
        Set wb = Nothing
    End If
Next ws

这篇关于使用VBA宏将每个Excel工作表保存为单独的工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！