如何修改宏实现将指定单元格内容自动填充至含autosum的区域？

原代码的核心问题 #

• 依赖Select/Activate操作，容易因选中状态变化触发错误
• 硬编码填充范围R7:U7，无法适配数千行的批量处理
• 仅查找第一个"autosum"单元格，未覆盖所有需要填充的位置
• 多余的Application.CutCopyMode = False语句无意义，反而可能引发异常

修改后的宏代码 #

Sub FillAutosumCells()
' 快捷键：Ctrl+Shift+A
    Dim ws As Worksheet
    Dim findRange As Range
    Dim firstFound As String
    
    ' 禁用屏幕刷新提升效率
    Application.ScreenUpdating = False
    Set ws = ActiveSheet ' 可改为具体工作表名，如ThisWorkbook.Worksheets("销售报表")
    
    ' 查找第一个"autosum"单元格
    Set findRange = ws.Range("S:U").Find(What:="autosum", LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
    
    If Not findRange Is Nothing Then
        firstFound = findRange.Address
        Do
            ' 将同一行R列的值填充到当前找到的单元格
            findRange.Value = ws.Cells(findRange.Row, "R").Value
            ' 查找下一个匹配项
            Set findRange = ws.Range("S:U").FindNext(findRange)
        ' 循环直到回到第一个找到的单元格
        Loop While Not findRange Is Nothing And findRange.Address <> firstFound
    End If
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
End Sub

代码说明 #

• 直接操作单元格对象，避免Select/Activate带来的不稳定问题
• 遍历S、T、U列所有包含"autosum"的单元格，批量填充对应行的R列值
• 使用LookIn:=xlValues（因为已粘贴为值，不需要查公式），LookAt:=xlWhole确保精确匹配"autosum"
• 禁用屏幕刷新，处理数千行时大幅提升运行速度
• 可直接指定目标工作表，避免依赖当前激活工作表

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