VBA功能扩展需求：复制表格指定列数据至同工作表目标列、刷新Power Query并自动填充公式

Gary你好，我仔细看了你的需求和遇到的调试问题，咱们把需要的功能整合到原代码里，同时优化一些容易出问题的操作（比如尽量不用Select，直接操作单元格更稳定）。

首先先给你修改好的完整代码，之后再逐段解释新增的部分：

Public Sub ChartOfAccountsOnly()
    Dim ws As Worksheet
    Dim lastRowA As Long
    Dim targetRowO As Long
    
    ' 关闭屏幕刷新和自动计算，提升运行速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 指定操作的工作表（避免切换工作表时出错）
    Set ws = ThisWorkbook.Sheets("Chart Of Accounts")
    
    ' 原功能：把A1的值复制到B1（替换原有的复制粘贴，更高效）
    ws.Range("B1").Value = ws.Range("A1").Value
    
    ' --- 新增功能1：复制A4到A列最后一行的数据，粘贴值到N4开始的位置 ---
    ' 获取A列最后有数据的行号
    lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 确保A4以下有数据才执行复制
    If lastRowA >= 4 Then
        ' 复制A4到lastRowA的内容，粘贴值到N4对应区域
        ws.Range("A4:A" & lastRowA).Copy
        ws.Range("N4").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False ' 清除复制模式
    End If
    
    ' 刷新Power Query连接
    ThisWorkbook.Connections("Query - GAL Chart Of Accounts").Refresh
    
    ' --- 新增功能2：自动填充O4的公式到对应行 ---
    ' 刷新PQ后，重新获取A列最后有数据的行号（因为PQ可能更新了数据）
    lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 确保O4有公式且A4以下有数据
    If lastRowA >= 4 And Not ws.Range("O4").Value = "" Then
        ' 自动填充公式从O4到O列对应lastRowA的位置
        ws.Range("O4").AutoFill Destination:=ws.Range("O4:O" & lastRowA)
    End If
    
    ' 原功能：更新最后刷新时间
    With ws.Range("B2")
        .Value = Now()
        .NumberFormat = "dd/mm/yyyy hh:mm:ss"
    End With
    
    ' 恢复屏幕刷新和自动计算
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

关键修改和说明： #

1. 替换Select操作：原代码里的Range("A1").Select这类操作容易因为工作表切换出错，直接用ws.Range("B1").Value = ws.Range("A1").Value完成值复制，更高效稳定。
2. 新增复制A列数据到N列：
   • 先获取A列最后有数据的行号lastRowA，判断如果行号≥4（确保A4以下有数据）才执行复制粘贴。
   • 用PasteSpecial xlPasteValues只粘贴值，避免格式或公式干扰。
3. 修复AutoFill的问题：
   • 刷新Power Query后重新获取lastRowA，因为PQ可能更新了A列的数据行数。
   • 增加判断条件：确保O4已经有需要填充的公式，且A4以下有数据，避免空填充导致的错误。
   • 明确指定工作表ws，避免在其他工作表执行操作引发调试错误。

注意事项： #

• 请确保O4单元格已经提前输入了你需要自动填充的公式，否则AutoFill没有源公式可以复制。
• 如果PQ刷新后A列数据行数没有变化，重新获取lastRowA的步骤也能保证填充范围准确。

备注：内容来源于stack exchange，提问作者Gary