如何使用VBA实现每隔30行复制指定单元格区域并粘贴到目标区域

实现逻辑 #

• 首个复制源区域为A4:C4，粘贴到首个目标区域P4:R4
• 后续源区域每次向下偏移30行选取（即4→34→64……），目标区域每次向下偏移1行粘贴（即4→5→6……）
• 遍历到A列最后一行有数据的单元格后自动终止

可直接运行的VBA代码 #

Sub CopyIntervalRows()
    Dim opSheet As Worksheet
    Dim sourceRow As Long, targetRow As Long, lastDataRow As Long
    
    ' 定义操作对象为当前活动工作表，如需指定固定表可替换为 Sheets("你的表名")
    Set opSheet = ActiveSheet
    ' 读取A列最后一个有数据的行号，作为遍历终止边界
    lastDataRow = opSheet.Cells(opSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化起始行号
    sourceRow = 4
    targetRow = 4
    
    ' 循环遍历符合规则的行
    Do While sourceRow <= lastDataRow
        ' 直接赋值传输数据，比普通复制粘贴运行速度更快，仅保留单元格值
        opSheet.Range("P" & targetRow & ":R" & targetRow).Value = _
            opSheet.Range("A" & sourceRow & ":C" & sourceRow).Value
        
        ' 行号按规则偏移
        sourceRow = sourceRow + 30
        targetRow = targetRow + 1
    Loop
    
    MsgBox "处理完成，共复制 " & targetRow - 4 & " 条数据", vbInformation
End Sub

使用说明 #

如果你需要保留源单元格的格式、公式等内容，把代码中直接赋值的两行替换为以下代码即可：

opSheet.Range("A" & sourceRow & ":C" & sourceRow).Copy _
    Destination:=opSheet.Range("P" & targetRow)

• 代码默认以A列数据作为最后行判断依据，如果你的数据有效行判断依据是C列，可将读取lastDataRow行代码中的列标"A"替换为"C"
• 运行前请确认你选中的是需要操作的工作表，避免误操作其他表的数据

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