如何用VBA实现Excel中每隔6列批量粘贴指定数据？

原代码问题分析 #

• 第一段代码循环行号而非列号，完全不符合跨列填充的需求；且未提前复制源数据，PasteSpecial操作依赖剪贴板内容，缺少前置复制步骤。
• 第二段代码虽循环列，但使用Rows(13).PasteSpecial会粘贴整行，无法精准填充固定范围的数据；同样可能遗漏源数据的复制操作，目标位置指定逻辑模糊。

正确实现代码 #

以下两种方案可按需选择：

方案1：直接复制（高效无剪贴板依赖）

适合仅需复制数据及格式的场景，无需占用剪贴板：

Sub FillEverySixColumns()
    ' 1. 定义源数据范围，替换为你的实际数据区域
    Dim sourceRange As Range
    Set sourceRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A10")
    
    ' 2. 定义目标列的起始、结束列号（示例：W列=23，AQ列=43）
    Dim startCol As Long, endCol As Long
    startCol = 23
    endCol = 43
    
    ' 3. 每隔6列循环填充
    Dim targetCol As Long
    For targetCol = startCol To endCol Step 6
        ' 将源数据复制到目标列的对应行范围
        sourceRange.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(sourceRange.Row, targetCol).Resize(sourceRange.Rows.Count, 1)
    Next targetCol
End Sub

方案2：使用PasteSpecial（支持自定义粘贴类型）

若需指定粘贴类型（如仅粘贴值、格式等），可使用此方案：

Sub FillEverySixColumnsWithPasteSpecial()
    ' 1. 定义源数据范围
    Dim sourceRange As Range
    Set sourceRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A10")
    
    ' 2. 定义目标起始列，获取工作表最后一列（自动填充到末尾）
    Dim startCol As Long, lastCol As Long
    startCol = 23
    lastCol = ThisWorkbook.Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' 3. 先复制源数据到剪贴板
    sourceRange.Copy
    
    ' 4. 循环填充
    Dim targetCol As Long
    For targetCol = startCol To lastCol Step 6
        ' 粘贴到目标列起始位置，可修改xlPasteAll为xlPasteValues等类型
        ThisWorkbook.Sheets("Sheet1").Cells(sourceRange.Row, targetCol).PasteSpecial xlPasteAll
    Next targetCol
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
End Sub

注意事项 #

• 替换代码中的Sheet1和源数据范围（A1:A10）为你的实际工作表名称和数据区域。
• 若需填充到工作表最后一列，可参考方案2的lastCol获取方式，无需手动指定endCol。

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