VBA双循环功能异常求助：按行间隔复制粘贴需求实现问题

看起来你已经察觉到问题出在嵌套循环上了——你的代码现在是每取一个源区域，就把它粘贴到所有目标位置，所以才会出现单个区域重复粘贴几百次的情况。我们需要的是源区域和目标位置一一对应：每取一个间隔50行的源数据，就粘贴到下一个间隔31行的目标位置，用单个循环就能搞定，完全不需要嵌套。

问题根源拆解 #

原代码里的外层For X循环负责遍历源区域的偏移，内层For Y循环负责遍历目标位置的偏移。这就导致每一个X对应的源数据，都会被粘贴到所有Y对应的目标行，最终每个源区域被重复粘贴数十次。正确的逻辑应该是：一次循环处理一组「源区域→目标位置」的对应关系。

修改后的代码 #

Sub makro3()
    Dim i As Integer, totalGroups As Integer
    totalGroups = 332 ' 你需要处理的总数据组数
    Dim sourceStartRow As Integer, targetStartRow As Integer
    Dim sourceWs As Worksheet, targetWs As Worksheet
    
    ' 提前绑定工作表对象，避免反复切换激活，更高效可靠
    Set sourceWs = ThisWorkbook.Sheets("Arkusz1")
    Set targetWs = ThisWorkbook.Sheets("dane")
    
    ' 单个循环处理每一组对应关系
    For i = 0 To totalGroups - 1
        ' 计算当前源区域的起始行：初始14，每次间隔50行
        sourceStartRow = 14 + i * 50
        ' 计算当前目标区域的起始行：初始2，每次间隔31行
        targetStartRow = 2 + i * 31
        
        ' 直接赋值单元格值，比Copy/PasteSpecial更高效，也避免选择操作
        ' 源区域：从第3列（C列）开始，取31行×20列（A1:T31对应C到V列）
        ' 目标区域：从第7列（G列）开始，同样31行×20列
        targetWs.Range(targetWs.Cells(targetStartRow, 7), targetWs.Cells(targetStartRow + 30, 26)).Value = _
            sourceWs.Range(sourceWs.Cells(sourceStartRow, 3), sourceWs.Cells(sourceStartRow + 30, 22)).Value
    Next i
End Sub

关键改进点 #

• 去掉嵌套循环：用单个循环变量i同步控制源和目标的偏移，确保一组源数据对应一个目标位置
• 避免Select/Activate：直接通过工作表对象引用单元格，减少运行时错误，同时大幅提升宏的运行速度
• 直接赋值Value：跳过复制粘贴的剪贴板操作，是VBA中批量赋值最快的方式
• 清晰的变量命名：把模糊的X/Y换成更有意义的名称，方便后续维护和调整

调整提示 #

如果需要修改总组数、起始行或者间隔行数，直接修改totalGroups、sourceStartRow/targetStartRow的计算逻辑即可。比如总组数不是332，改成你实际需要的数字就行。

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