Excel VBA代码优化请求：实现首行公式批量粘贴到动态数据区域对应行

我来帮你解决这个问题～你的核心问题在于：当前代码里的idataRange1、idataRange2、idataRange3都只指向单个单元格，所以复制首行公式时只会粘贴到那一行，而不是覆盖所有数据对应的行。我们需要先计算粘贴的数据行数，再把公式区域扩展到对应行数，完成批量粘贴。

问题分析 #

你从SET UP表的C17:D[最后行]复制数据到其他工作表，数据行数是动态的（iLastRowS1 - 16，因为从第17行开始）。但粘贴公式时，只指定了起始单元格，没有扩展到和数据一样多的行数，导致只粘贴了第一行。

修改后的优化代码 #

我重构了代码，把重复的操作封装成通用子过程，既解决了公式批量粘贴的问题，也让代码更简洁易维护：

'move data and populate formulas
Sub CopyDataAndFormulas()
    Application.ScreenUpdating = False
    
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim s3 As Worksheet
    Dim s4 As Worksheet
    Dim iLastRowS1 As Long
    Dim dataRows As Long
    
    Set s1 = Sheets("SET UP")
    Set s2 = Sheets("New")
    Set s3 = Sheets("Current")
    Set s4 = Sheets("Proposed")
    
    ' 获取SET UP表中C列最后一行，计算要复制的数据行数
    iLastRowS1 = s1.Cells(s1.Rows.Count, "C").End(xlUp).Row
    dataRows = iLastRowS1 - 16 ' 因为数据从C17开始，行数=最后行-16
    
    ' 处理每个工作表的通用逻辑
    ProcessWorksheet s1, s2, 1, "E1:O1", dataRows
    ProcessWorksheet s1, s3, 1, "E1:O1", dataRows
    ProcessWorksheet s1, s4, 2, "E1:AU1", dataRows
    
    Application.ScreenUpdating = True
End Sub

' 通用子过程：处理数据复制和公式批量粘贴
Private Sub ProcessWorksheet(sourceSheet As Worksheet, targetSheet As Worksheet, _
                            targetOffsetRows As Long, formulaRangeAddr As String, dataRows As Long)
    Dim targetDataStart As Range
    Dim targetFormulaStart As Range
    Dim targetFormulaRange As Range
    
    ' 确定数据粘贴的起始单元格
    Set targetDataStart = targetSheet.Cells(targetSheet.Rows.Count, "B").End(xlUp).Offset(targetOffsetRows, 0)
    ' 复制数据到目标工作表
    sourceSheet.Range("C17", sourceSheet.Cells(sourceSheet.Cells(sourceSheet.Rows.Count, "C").End(xlUp).Row, "D")).Copy targetDataStart
    
    ' 确定公式粘贴的起始单元格（D列右侧，即E列开始）
    Set targetFormulaStart = targetDataStart.Offset(0, 3)
    ' 扩展公式区域到对应的数据行数
    Set targetFormulaRange = targetFormulaStart.Resize(dataRows, targetSheet.Range(formulaRangeAddr).Columns.Count)
    
    ' 复制首行公式并粘贴到目标区域
    targetSheet.Range(formulaRangeAddr).Copy
    targetFormulaRange.PasteSpecial xlPasteFormulas ' 只粘贴公式，避免格式问题
    
    Application.CutCopyMode = False ' 清除剪贴板
End Sub

关键改进点 #

• 通用子过程：把重复的数据复制、公式粘贴逻辑封装成ProcessWorksheet，减少代码冗余，后续修改更方便
• 动态扩展公式区域：用Resize(dataRows, 列数)把公式区域扩展到和数据行数一致，确保每一行数据都对应公式
• 明确粘贴公式：使用PasteSpecial xlPasteFormulas只粘贴公式，避免不必要的格式复制
• 计算数据行数：提前算出要复制的数据行数，确保公式区域和数据区域完全匹配

这样修改后，公式就会批量粘贴到所有数据对应的行，而不是只粘贴第一行啦～

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