Excel VBA需求：按指定次数将列值复制到另一工作表同列

你的代码之所以会横向填充到G、H等列，核心原因是内层循环里用Cells(i, ii)指定了行对应原表的i行，列从7开始递增，相当于在同一行的不同列重复填数据，自然就横向展开了。要改成G列逐行向下填充，得跟踪目标表G列的当前行位置，每次填完一行就往下挪一行。

修正后的代码如下：

Sub Copy_Paste()
    Dim StartRow As Byte
    Dim LastRow As Long
    Dim i As Integer
    Dim cnt As Integer
    Dim targetRow As Long ' 记录目标表G列的当前填充行
    
    ' 初始化目标行：假设G列从第2行开始填充（可根据实际需求调整）
    targetRow = 2
    
    ' 可靠获取Volunteer List表A列最后一行数据的行号
    LastRow = Sheets("Volunteer List").Cells(Sheets("Volunteer List").Rows.Count, "A").End(xlUp).Row
    StartRow = 2
    
    ' 遍历Volunteer List表的每一行数据
    For i = StartRow To LastRow
        ' 跳过A列为空的行
        If Sheets("Volunteer List").Range("A" & i).Value <> "" Then
            cnt = Sheets("Volunteer List").Range("D" & i).Value
            ' 按指定次数逐行填充到目标表G列
            For cnt = 1 To cnt
                Sheets("Individual Contacts").Range("G" & targetRow).Value = Sheets("Volunteer List").Range("A" & i).Value
                targetRow = targetRow + 1 ' 填充完一行，目标行下移一位
            Next cnt
        End If
    Next i
End Sub

关键改动说明：

• 新增targetRow变量：专门跟踪"Individual Contacts"表G列当前要填充的行号，每次填充后自动加1，确保下一次数据往下填。
• 移除不必要的工作表激活：直接通过Sheets("表名").Range/Cell引用单元格，避免频繁切换工作表的麻烦，代码稳定性更高。
• 修正最后一行的获取逻辑：原代码用CurrentRegion可能会因中间空行导致错误，改用End(xlUp)从表格底部往上查找最后一行数据，结果更可靠。
• 内层循环逻辑调整：不再遍历列号，而是按指定次数循环，每次填充G列的targetRow行，实现纵向逐行填充的效果。

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