VBA实现Sheet1的A列单元格循环赋值给Sheet2首行对应单元格

需求说明 #

需要实现的逻辑：将Sheets(1)中A列指定范围的单元格值，按先后顺序一一对应赋值给Sheets(2)目标行的每个单元格。
你提供的示意代码仅作需求参考，原代码如下：

For Each cell In sheets(1).Range("A50:A606")
For Each cell2 In sheets(2).Range("EX2:ACB2")

   cell2.Value = cell.Value
Next
Next

原代码问题点 #

• 双层嵌套循环逻辑错误：外层每读取一个A列单元格，内层就会遍历完目标区域所有单元格并覆盖值，最终目标区域所有单元格都会被赋值为A列最后一个单元格的值，无法实现顺序一一对应
• 目标区域行号不匹配：你写的目标区域是第2行的EX2:ACB2，和需求中“赋值给第2张表第1行”的描述不一致，可根据实际需要调整行号
• 缺少合规性校验：未判断源区域和目标区域的单元格数量是否一致，数量不匹配时会出现赋值不全或者越界报错

正确代码实现 #

写法1：索引对应循环（逻辑直观，适合小数据量场景） #

Sub 按顺序跨表赋值()
    Dim sourceRng As Range, targetRng As Range
    Dim i As Long
    
    ' 定义源区域：表1 A列A50到A606
    Set sourceRng = Sheets(1).Range("A50:A606")
    ' 定义目标区域：表2 第1行对应列范围，若实际需要写入第2行，把Range里的行号1改成2即可
    Set targetRng = Sheets(2).Range("EX1:ACB1")
    
    ' 单元格数量校验
    If sourceRng.Cells.Count <> targetRng.Cells.Count Then
        MsgBox "源区域和目标区域单元格数量不匹配，请检查范围！"
        Exit Sub
    End If
    
    ' 按索引顺序一一赋值
    For i = 1 To sourceRng.Cells.Count
        targetRng.Cells(i).Value = sourceRng.Cells(i).Value
    Next i
End Sub

写法2：数组批量赋值（运行效率高，适合大数据量场景） #

不需要逐单元格读写工作表，直接把源区域值读入内存数组后一次性写入目标区域，数据量大时速度提升明显：

Sub 按顺序跨表赋值_数组版()
    Dim sourceArr As Variant
    Dim sourceRng As Range, targetRng As Range
    
    Set sourceRng = Sheets(1).Range("A50:A606")
    ' 目标区域行号按需调整，当前为第1行
    Set targetRng = Sheets(2).Range("EX1:ACB1")
    
    If sourceRng.Cells.Count <> targetRng.Cells.Count Then
        MsgBox "源区域和目标区域单元格数量不匹配，请检查范围！"
        Exit Sub
    End If
    
    ' 读取源区域值到内存数组
    sourceArr = sourceRng.Value
    ' 单列转单行写入目标区域，需要调用转置函数
    targetRng.Value = WorksheetFunction.Transpose(sourceArr)
End Sub

提示：如果你的实际需求确实是要赋值到Sheets(2)的第2行，只需要把上述代码中目标区域的行号从1修改为2即可，列范围保持EX:ACB无需改动。

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