Excel VBA跨工作表按步长6复制数据后向下填充覆盖问题如何解决

问题根源 #

你现有代码的问题出在目标单元格行号的计算逻辑错误：内层循环的目标行没有跟随外层循环的偏移量变化，不管外层RowNo2循环到多少，目标行永远固定是3~8，所以会一直重复覆盖该区域。

修正后的代码 #

Sub CopyDataInBetweenCells()
     Dim wb As Workbook
     Set wb = ThisWorkbook

     Dim destws As Worksheet
     Set destws = wb.Worksheets("Worksheet (2)")

     Dim RowNo2 As Long
     Dim startRow As Long
     
     ' 按规则每个源值的起始行依次为2、8、14...步长为6
     For RowNo2 = 1 To 2000
        startRow = RowNo2 * 6 - 4
        ' 起始行无值说明已处理完所有复制数据，自动退出循环
        If destws.Cells(startRow, 1).Value = "" Then Exit For
        ' 直接批量赋值填充下方6行，无需嵌套循环
        destws.Range(destws.Cells(startRow + 1, 1), destws.Cells(startRow + 6, 1)).Value = destws.Cells(startRow, 1).Value
     Next RowNo2
End Sub

逻辑说明 #

• 完全匹配填充规则：A2填充A3_{A8、A8填充A9}A14、A14填充A15~A20，以此类推
• 去掉冗余嵌套循环，用批量赋值方式大幅提升运行效率
• 增加空值自动停止逻辑，避免无意义的空循环

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