如何在Excel VBA宏中添加代码自动将新建工作表命名为当前日期

你录制的宏里目前是固定把新表命名为09-07-22，要实现自动用当前日期命名，只需要做几个关键修改，同时可以优化掉宏录制生成的冗余操作（比如大量的滚动、选择操作，这些对功能没帮助还拖慢代码）。

关键修改点： #

• 用Format(Date, "mm-dd-yy")生成指定格式的当前日期字符串，作为工作表名称
• 新建工作表时直接将其赋值给变量，避免依赖默认的Sheet1名称（如果已有同名工作表会报错）
• 移除不必要的Select/Activate和窗口滚动操作，让代码更简洁高效

修改并优化后的完整宏代码： #

Sub Macro_NWP()
    ' Macro_NWP Macro
    ' Keyboard Shortcut: Ctrl+n
    
    Dim newSheet As Worksheet
    Dim dateName As String
    
    ' 生成指定格式的当前日期字符串
    dateName = Format(Date, "mm-dd-yy")
    
    ' 检查是否已有同名工作表，避免报错
    On Error Resume Next
    Set newSheet = ThisWorkbook.Worksheets(dateName)
    On Error GoTo 0
    
    If Not newSheet Is Nothing Then
        MsgBox "今天的报表工作表已存在！", vbExclamation
        Exit Sub
    End If
    
    ' 新建工作表并命名
    Set newSheet = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
    newSheet.Name = dateName
    
    ' 处理"Project Status"工作表的筛选和复制
    With ThisWorkbook.Worksheets("Project Status")
        ' 清除排序并显示全部数据
        .AutoFilter.Sort.SortFields.Clear
        .ShowAllData
        
        ' 应用筛选
        .Range("$A$1:$Y$290").AutoFilter Field:=3, Criteria1:="In Progress"
        
        ' 复制指定列到新表
        .Range("A:C,F:F,M:Y").Copy Destination:=newSheet.Range("A1")
    End With
    
    ' 设置列宽
    With newSheet
        .Columns("A:C,F:F,N:O,Q:Y").ColumnWidth = 20
        .Columns("B:B").ColumnWidth = 50
        .Columns("M:M,P:P").ColumnWidth = 60
        
        ' 冻结窗格
        .Range("E2").Select
        ActiveWindow.FreezePanes = True
        
        ' 设置缩放比例
        ActiveWindow.Zoom = 70
    End With
End Sub

代码说明： #

1. 日期命名部分：Format(Date, "mm-dd-yy")会自动获取系统当前日期，并格式化为月-日-年（两位数字）的形式，比如当天是2024年5月20日，就会生成05-20-24。
2. 重名检查：添加了判断逻辑，如果当天已经生成过同名工作表，会弹出提示并退出宏，避免因重名导致报错。
3. 优化冗余操作：删掉了宏录制时生成的所有ActiveWindow.ScrollColumn和重复的Zoom设置，直接通过对象操作完成复制、列宽设置等，代码运行更快更稳定。
4. 避免Select/Activate：大部分操作直接通过With语句操作工作表对象，不需要频繁切换工作表，减少代码出错概率。

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