如何将带公式工作表另存为值粘贴格式至指定文件夹并更名

以下是满足你需求的修改后代码，同时解释关键调整点：

修改后完整代码 #

Sub ExportSheetAsHardCopy()
    Dim sourceSheet As Worksheet
    Dim targetWB As Workbook
    Dim savePath As String
    Dim originalFileName As String
    Dim newFileName As String
    
    ' 指定要提取的工作表（替换成你的目标表名）
    Set sourceSheet = ThisWorkbook.Sheets("Radiant_Trades")
    ' 指定保存的目标文件夹（路径末尾必须加\，替换成你的实际路径）
    savePath = "C:\YourTargetFolder\"
    
    ' 复制工作表到新工作簿（自动保留原标签名）
    sourceSheet.Copy
    Set targetWB = ActiveWorkbook
    
    ' 将区域内容转为值+格式，清除公式
    With targetWB.Sheets(1).UsedRange
        .Copy
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    Application.CutCopyMode = False
    
    ' 自动生成带"hc"的文件名：原工作簿名 + "hc" + 后缀
    originalFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    newFileName = savePath & originalFileName & "hc.xlsx"
    
    ' 保存新工作簿（xlOpenXMLWorkbook对应xlsx格式）
    targetWB.SaveAs Filename:=newFileName, FileFormat:=xlOpenXMLWorkbook
    ' 可选：保存后自动关闭新工作簿，取消注释即可
    ' targetWB.Close SaveChanges:=False
End Sub

关键调整说明 #

• 指定固定保存路径：修改savePath变量的值为你的目标文件夹，注意路径末尾必须加\，比如"D:\备份文件\硬拷贝\"
• 自动生成带"hc"的文件名：从原工作簿名称中提取不带后缀的部分，自动拼接"hc"和xlsx后缀，无需手动输入
• 保留原工作表标签名：直接复制原工作表到新工作簿，标签名会自动保留，无需额外设置
• 简化值粘贴逻辑：用UsedRange一次性处理整个数据区域，比原代码更高效

对原代码的优化点 #

• 替换了代码1中手动选择路径的GetSaveAsFilename，改为自动按规则保存
• 改进了代码2中固定文件名的逻辑，改为动态获取原工作簿名称，适配不同文件
• 增加了变量定义，让代码更清晰易维护

内容的提问来源于stack exchange，提问作者Sonny