保存工作表而不是完整的工作簿答案

【问题标题】：Save a sheet instead of a complete workbook保存工作表而不是完整的工作簿
【发布时间】：2022-01-21 19:20:52
【问题描述】：

我目前正在使用以下代码来保存 Excel 工作簿。我不想保存完整的工作簿，而是希望在此工作簿中保存一个名为 Reconciliation 的工作表。工作表中的所有值都应保存为值，同时保持格式不变。

Sub Button3_Click()
    ' Yes
    ' Code to save consumer wise mirs on the desktop

    Dim Path As String
    Dim filename As String

    On Error GoTo Err_Clear

    Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"

    filename = Range("A1")
    ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    Err_Clear:
        If Err <> 0 Then
            MkDir CreateObject("wscript.shell").specialfolders("desktop") & "\rohailnisar"

            Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
            filename = Range("A1")
            ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled

        End If
End Sub

【问题讨论】：

您必须将工作表复制到您创建的新工作簿中，然后保存该工作簿，因为工作表无法单独保存。
可以通过修改上面的代码来实现吗
您的代码所做的只是保存工作簿，因此这是您需要做的事情之一，请确保您可以添加到其中。
代码是否在同一个工作簿中？如果不是，它是开放的还是封闭的？保存位置是什么，例如Environ("USERPROFILE") & "\Desktop\rohailnisar\"?新工作簿的名称（和格式）是什么，例如Reconciliation.xlsx?
同一个工作簿，类似主文件，新文件名应该是E1中的值

标签： excel vba

【解决方案1】：

导出工作表

这会将工作表的副本保存为同一文件夹中新工作簿中的唯一工作表。在保存之前，它将公式转换为值。它以.xlsx 格式保存“删除”任何代码。
如果代码在打开的（初始）工作簿中，则将ActiveWorkbook 替换为ThisWorkbook。

Option Explicit

Sub SaveWorksheet()
    On Error GoTo ClearError

    Dim swb As Workbook: Set swb = ActiveWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets("Reconciliation")          

    Dim FolderPath As String: FolderPath = swb.Path & Application.PathSeparator
    Dim BaseName As String: BaseName = sws.Range("E1").Value
    
    Dim FilePath As String: FilePath = FolderPath & BaseName & ".xlsx"
    
    sws.Copy

    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    dwb.Worksheets(1).UsedRange.Value = dwb.Worksheets(1).UsedRange.Value 
    Application.DisplayAlerts = False ' overwrite without confirmation
    dwb.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    'dwb.Close

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume ProcExit
End Sub

【讨论】：

Set dwb = ActiveWorkbook 有时会产生意想不到的结果。最好使用Set dwb = Workbooks(Workbooks.Count)
@Siddharth Rout：很有趣。暂时没遇到这个问题。谢谢。
谢谢，由于某些原因，BaseName = swb.Range("E1").Value 存在一些问题。我将其更改为 BaseName = Range("E1") 并且它有效。还有一件事，文件夹中已经存在相同的文件名是什么，我希望它用 sam 名称替换旧文件。
你修复的是我的大错误。您需要添加工作表，例如swb.Worksheets("Reconciliation").Range("E1").Value。我以这种方式修复了它。我还添加了使用Application.DisplayAlerts 的无确认覆盖部分。
谢谢您，先生，它根据需要工作，非常感谢您的帮助。如果你也可以看看这个，请stackoverflow.com/questions/70447912/…

【解决方案2】：

我不想保存完整的工作簿，而是希望在此工作簿中保存一张名为 Reconciliation 的工作表。工作表中的所有值都应保存为值，同时保持格式相同。

代码

Dim wbThis As Workbook
Dim wsThis As Worksheet

Dim wbThat As Workbook
Dim wsThat As Worksheet

'~~> Change this to the workbook which has the Reconciliation sheet
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Reconciliation")

'~~> This will create a new workbook with only Reconciliation
wsThis.Copy
    
'~~> Get that object. It will be last in the queue
Set wbThat = Workbooks(Workbooks.Count)
Set wsThat = wbThat.Sheets("Reconciliation")

'~~> Convert to values
wsThat.UsedRange.Value = wsThat.UsedRange.Value

'~~> Save that workbook
wbThat.SaveAs Filename:=Path & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled

【讨论】：