VBA数据复制代码首次运行失效问题求助

问题原因 #

核心问题是ActiveWorkbook.RefreshAll默认采用异步执行模式：调用该方法后，VBA代码会立刻继续执行Call Action，但此时数据库连接的刷新操作还未完成，Action读取的仍然是刷新前的旧数据。

手动操作时你会等待刷新完成再复制，结果正常；但通过auto_Open触发时，代码连续执行，就会出现时序错位的问题。

解决方案 #

方案1：强制同步刷新（推荐） #

将所有数据库查询设置为同步执行，确保刷新完成后再运行Action：

Sub Refresh()
    ' 禁用所有QueryTable的后台异步刷新
    Dim qt As QueryTable
    For Each qt In ActiveWorkbook.QueryTables
        qt.BackgroundQuery = False
    Next qt
    
    ' 针对Excel表（ListObject）的外部连接做同样设置
    Dim lo As ListObject
    For Each lo In ThisWorkbook.Worksheets("DATA").ListObjects
        If lo.SourceType = xlSrcExternal Then
            lo.QueryTable.BackgroundQuery = False
        End If
    Next lo
    
    ActiveWorkbook.RefreshAll
    Call Action
End Sub

方案2：等待刷新完成后再执行Action #

如果需要保留异步刷新（比如刷新数据量极大），可以添加循环等待逻辑，直到所有刷新任务完成：

Sub Refresh()
    ActiveWorkbook.RefreshAll
    
    ' 等待所有QueryTable刷新完成
    Dim qt As QueryTable
    Do
        DoEvents ' 释放控制权让Excel处理刷新
        For Each qt In ActiveWorkbook.QueryTables
            If qt.Refreshing Then Exit For
        Next qt
    Loop While qt.Refreshing
    
    ' 等待所有ListObject外部连接刷新完成
    Dim lo As ListObject
    Do
        DoEvents
        For Each lo In ThisWorkbook.Worksheets("DATA").ListObjects
            If lo.SourceType = xlSrcExternal And lo.QueryTable.Refreshing Then Exit For
        Next lo
    Loop While lo.SourceType = xlSrcExternal And lo.QueryTable.Refreshing
    
    Call Action
End Sub

额外优化：避免不必要的Select操作 #

你的Action子程序依赖工作表激活，容易引发意外问题，建议直接引用工作表对象：

Sub Action()
    Application.ScreenUpdating = False
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("DATA")
    
    With wsData
        .Range("av5:av7").Value = .Range("au5:au7").Value
        .Range("av11:av15").Value = .Range("at11:at15").Value
        .Range("at20:at35").Value = .Range("au20:au35").Value
        .Range("ay20:ay35").Value = .Range("az20:az35").Value
        .Range("bc20:bc35").Value = .Range("bd20:bd35").Value
        .Range("bg20:bg35").Value = .Range("bh20:bh35").Value
        .Range("av49:av51").Value = .Range("au49:au51").Value
        .Range("ax49:ax51").Value = .Range("ax45:ax47").Value
        .Range("ba53:bc55").Value = .Range("ba49:bc51").Value
        .Range("bg45:bg49").Value = .Range("bf45:bf49").Value
        .Range("av53:aw55").Value = .Range("av45:aw47").Value
    End With
    Application.ScreenUpdating = True
End Sub

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