无法填充命名区域：VBA跨工作表行数据转移问题求助

你的代码核心问题出在对Union合并后的区域遍历方式错误，以及赋值逻辑不符合需求，导致无法正确填充命名区域。我来一步步拆解问题并给出修复方案：

为什么原代码无法工作？ #

1. Areas的使用错误：Union(Pinformation, Bkriterier, inser)会生成一个包含3个独立区域的集合（对应三个命名区域），AllProjectInformation.Areas的长度是3，但你循环的是AllProjectInformation.Cells.Count（约60次）。当i > 3时，访问Areas(i)会直接触发「下标越界」错误。
2. 赋值逻辑错误：就算i在1-3范围内，AllProjectInformation.Areas(i)是一整块区域，而projectRow.Range(i)是单个单元格，直接赋值会把单个值填充到整个区域，这显然不是你要的「逐个单元格对应转移」效果。

修正后的代码方案 #

方案1：逐个单元格对应赋值（直观易理解） #

这个方法会遍历目标区域的每一个单元格，同时对应projectRow里的源单元格，确保数据精准对应：

Dim Bkriterier As Range
Dim Pinformation As Range
Dim inser As Range
Dim AllProjectInformation As Range
Dim targetCell As Range
Dim cellIndex As Integer

Set Pinformation = InputSheet_Utveckling.Range("RProjekt")
Set Bkriterier = InputSheet_Utveckling.Range("RBkriterier")
Set inser = InputSheet_Utveckling.Range("Rinser")
Set AllProjectInformation = Union(Pinformation, Bkriterier, inser)

' 先校验源数据和目标区域的单元格数量是否匹配
If AllProjectInformation.Cells.Count <> projectRow.Range.Cells.Count Then
    MsgBox "错误：源数据行与目标区域的单元格数量不匹配，请检查！"
    Exit Sub
End If

cellIndex = 1
' 遍历目标区域的每一个单元格，逐个赋值
For Each targetCell In AllProjectInformation.Cells
    targetCell.Value = projectRow.Range.Cells(cellIndex).Value
    cellIndex = cellIndex + 1
Next targetCell

方案2：数组批量赋值（更高效） #

如果数据量较大，用数组批量处理会比逐个单元格循环更快：

Dim Bkriterier As Range
Dim Pinformation As Range
Dim inser As Range
Dim AllProjectInformation As Range
Dim sourceData As Variant
Dim cell As Range
Dim i As Integer

Set Pinformation = InputSheet_Utveckling.Range("RProjekt")
Set Bkriterier = InputSheet_Utveckling.Range("RBkriterier")
Set inser = InputSheet_Utveckling.Range("Rinser")
Set AllProjectInformation = Union(Pinformation, Bkriterier, inser)

' 校验数量匹配
If AllProjectInformation.Cells.Count <> projectRow.Range.Cells.Count Then
    MsgBox "错误：源数据行与目标区域的单元格数量不匹配，请检查！"
    Exit Sub
End If

' 把源行数据转为一维数组（两次Transpose实现二维转一维）
sourceData = Application.Transpose(Application.Transpose(projectRow.Range.Value))

i = 1
For Each cell In AllProjectInformation.Cells
    cell.Value = sourceData(i)
    i = i + 1
Next cell

注意事项 #

• 请确保projectRow对应的行中，数据的顺序和三个命名区域的单元格顺序完全一致（Union后的单元格会按Excel默认的「先行后列」顺序排列），如果顺序不对，需要调整命名区域的单元格顺序，或者修改遍历逻辑。
• 新增的数量校验可以提前发现数据不匹配的问题，避免后续出现意外错误。

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