如何无需指定工作表名称或编号保存当前选中的工作表？

Private Sub CommandButton4_Click() ' 保存当前选中工作表
    Dim currentSheet As Worksheet
    Set currentSheet = ActiveSheet ' 获取当前选中/激活的工作表
    
    ' 将当前工作表复制到新工作簿
    currentSheet.Copy
    
    Dim NameFile As Variant
    ' 初始文件名设为下载目录+当前工作表名称
    NameFile = Application.GetSaveAsFilename( _
        InitialFileName:=Environ("USERPROFILE") & "\Downloads\" & currentSheet.Name & ".xls", _
        FileFilter:="Excel 文件 (*.xls), *.xls")

    If NameFile = False Then
        MsgBox "文件未保存"
    Else
        ActiveWorkbook.SaveAs Filename:=NameFile
    End If
    
    ' 关闭新生成的工作簿，返回原工作簿
    ActiveWorkbook.Close
End Sub

关键修改说明 #

• 移除原代码中硬编码的Worksheets("Quote")，改用ActiveSheet直接获取当前选中/激活的工作表，无需手动指定表名或编号
• 修复原代码中初始文件名空值问题，直接用当前工作表名称作为默认文件名，配合下载目录生成合理的初始保存路径
• 删除冗余的注释和未生效代码块，简化逻辑，确保仅对当前选中的单个工作表执行保存操作
• 保留原有的xls格式筛选和下载目录默认设置，保持原有交互逻辑不变

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