VBA定时自动执行问题求助：无报错但无法每30秒自动运行

原代码的核心问题 #

• Timer子程序中定义的字符串变量clear_existing_data_before_paste未赋值，导致Application.OnTime无法定位要执行的宏
• 仅单次调用OnTime，执行一次复制后不会自动重复触发
• 缺少定时器的自动启动逻辑，只能手动运行Timer

修正后的完整代码 #

1. 标准模块中的代码（例如Module1） #

Sub clear_existing_data_before_paste()
    Dim wscopy As Worksheet
    Dim wsdest As Worksheet
    Dim lcopyLastrow As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False ' 避免触发不必要的事件干扰
    End With

    Set wscopy = ThisWorkbook.Worksheets("NEWROUND")
    ' 打开目标工作簿并指定工作表
    Set wsdest = Workbooks.Open("F:\DELEGATION APPLICATION\2-2023\DATABASE-2-2023.xlsm").Worksheets("All Data")

    ' 获取源数据最后一行
    lcopyLastrow = wscopy.Cells(wscopy.Rows.Count, "A").End(xlUp).Row
    
    ' 清空目标表原有数据（从A2到N列最后一行）
    wsdest.Range("A2:N" & wsdest.Cells(wsdest.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 复制源数据到目标表指定位置
    wscopy.Range("A2:N" & lcopyLastrow).Copy wsdest.Range("A2")

    ' 保存并关闭目标工作簿
    wsdest.Parent.Save
    wsdest.Parent.Close SaveChanges:=False ' 已手动保存，此处无需重复保存

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    ' 再次调用定时器，实现循环定时
    timer
End Sub

Sub timer()
    ' 直接传递宏名称字符串，无需额外变量
    Application.OnTime Now + TimeValue("00:00:30"), "clear_existing_data_before_paste"
End Sub

' 可选：用于关闭工作簿时取消定时任务，避免后续报错
Sub cancelTimer()
    On Error Resume Next ' 防止任务不存在时触发错误
    Application.OnTime EarliestTime:=Now + TimeValue("00:00:30"), Procedure:="clear_existing_data_before_paste", Schedule:=False
End Sub

2. 工作簿事件模块（ThisWorkbook） #

打开VBA编辑器后，双击左侧的ThisWorkbook，粘贴以下代码：

Private Sub Workbook_Open()
    ' 工作簿打开时自动启动定时器
    timer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 关闭工作簿时取消定时任务
    cancelTimer
End Sub

关键修正点说明 #

• 循环触发定时器：在clear_existing_data_before_paste末尾调用timer，确保每次复制完成后自动设置下一次定时
• 正确传递宏名称：Application.OnTime的第二个参数直接使用宏名称字符串，避免变量未赋值的问题
• 事件管控：操作工作簿时禁用EnableEvents，防止不必要的Excel事件干扰流程
• 自动启停逻辑：通过Workbook_Open自动启动定时器，Workbook_BeforeClose清理定时任务，避免Excel关闭后仍尝试执行宏导致报错

内容的提问来源于stack exchange，提问作者Funny Memo Ms