ActiveSheet.SaveAs 仅保存第一个工作表 - 多次，但仅在某些机器上答案

【问题标题】：ActiveSheet.SaveAs only saves first worksheet - multiple times, but only on some machinesActiveSheet.SaveAs 仅保存第一个工作表 - 多次，但仅在某些机器上
【发布时间】：2015-09-17 14:18:38
【问题描述】：

以下 VBA sn-p 在一台装有 Excel 版本的机器上正常工作 “Microsoft(R) Office Excel(R) 2007 (12.0.6727.5000) SP3 MSO (12.0.6728.5000)” 但不是与 “Microsoft(R) Office Excel(R) 2007 (12.0.6729.5000) SP3 MSO (12.0.6728.5000)”

中断和单步执行表示 wSheet 正在迭代已知工作表，但导出的文件仅包含第一个工作表的内容 - 即 sheet1.csv、sheet2.csv、sheet3.csv 均已保存，但每个一个包含工作簿中 sheet1 的内容。

仅保存活动工作表的单独“宏”的行为相同 - 无论在调用“宏”时哪个工作表处于活动状态，仅保存第一个工作表中的数据，但保存到名为活动工作表。 DBPrint 语句还显示 wSheet 正在遍历工作表。（DBPrint 只是一个带有开/关开关的 Debug.Print。）

  For Each wSheet In ActiveWorkbook.Worksheets
    wSheet.Activate
    wSheetName = wSheet.Name
    SaveAsName = wBookName & "." & wSheetName & ".csv"
    DBPrint "saving as " & SaveAsName
    On Error Resume Next
      wSheet.SaveAs filename:=SaveAsName, FileFormat:=xlCSV
      ' ... error handling code (no errors reported, though)
    On Error GoTo 0
  Next wSheet

【问题讨论】：

从你的休息和单步走，我认为这不会找到任何有用的东西，但你介意试试这个吗？在On Error Resume Next 之后，输入Msgbox wSheet.Name 并确保它每次都说出预期的名称？抱歉，如果是我自己的代码，我会从这里开始。
谢谢你，puzzlepiece87。 Msgbox 报告了所有导出工作表的正确工作表名称，但实际上仍然导出了第一个工作表的内容。
啊，那我不知道还有什么问题（除非它与 .csv 文件有关，我从不使用），但我发布了一个解决方法。
对了，你把wBookName设置在什么地方了吗？
它也可能因为您使用 ActiveWorkbook 而中断。

标签： vba excel

【解决方案1】：

我的解决方法：

Dim Workbook1 As Workbook

Set Workbook1 = ActiveWorkbook
For Each wSheet In Workbook1.Sheets
    SaveAsName = wBookName & "." & wSheet.Name & ".csv"
    DBPrint "saving as " & SaveAsName
    wSheet.Copy After:=Workbook1.Sheets(Workbook1.Sheets.Count)
    Workbook1.Sheets(Workbook1.Sheets.Count).Move
    ActiveWorkbook.SaveAs filename:=SaveAsName, FileFormat:=xlCSV
    ActiveWorkbook.Close False
Next wSheet

尝试一下，如果它有效，请告诉我。

【讨论】：

哇！这样可行！谢谢你。似乎它将活动工作表移动到“队列的前面”，然后保存它。它仍然只保存第一个工作表，但现在这是正确的。非常感谢。
没错。您可能已经知道，但 .Move 命令将工作表移动到新工作簿。我知道您希望完成后原始工作簿完好无损，所以我先创建一个.Copy，然后再移动它。

【解决方案2】：

我遇到了同样的问题，有一段时间使用了@puzzlepiece 的解决方法。它运行良好，但随着我必须使用的数据集变大而变得有点慢。

幸运的是，我找到了一个不需要复制和移动的修复：https://www.extendoffice.com/documents/excel/628-excel-split-workbook.html

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

【讨论】：