求助：Excel多命名区域复制公式并调整大小的解决方案（End函数失效）

我完全懂你的困扰——当工作表里有多个上下排列的单行命名区域时，End(xlUp)根本靠不住，因为它是在整列里找最后一个非空单元格，很容易被其他命名区域的内容干扰，导致复制位置出错。咱们换个思路，直接针对单个命名区域本身来操作，完全避开整列的影响。

核心思路 #

每个命名区域本身就是单行，所以它的"最后一行"就是它自己所在的行。要复制公式到下方，直接用Offset定位到它的下一行就行；之后再调整命名区域的引用范围，把新添加的行包含进去。

针对单个命名区域循环复制的代码 #

如果你是要对某个特定命名区域（比如tablename）循环多次复制（比如2次），可以用这段代码：

Dim targetRange As Range
Dim namedRange As Name
Dim i As Integer

' 先获取目标命名区域的对象
Set namedRange = ThisWorkbook.Names("tablename")
Set targetRange = namedRange.RefersToRange

For i = 1 To 2
    ' 复制当前区域的最后一行到下一行（因为初始是单行，就是复制这一行）
    targetRange.Rows(targetRange.Rows.Count).Copy Destination:=targetRange.Offset(targetRange.Rows.Count, 0)
    ' 调整命名区域的大小，把新行加进去
    namedRange.RefersTo = targetRange.Resize(targetRange.Rows.Count + 1)
    ' 更新targetRange为扩展后的新区域，方便下一次循环
    Set targetRange = namedRange.RefersToRange
Next i

遍历所有单行命名区域的代码 #

如果你的工作表里有多个单行命名区域，要逐个处理它们，复制公式到下一行并扩展区域，可以用这段：

Dim namedRange As Name
Dim targetRange As Range

For Each namedRange In ThisWorkbook.Names
    ' 先确保命名区域存在且在目标工作表resizeSh上
    On Error Resume Next
    Set targetRange = namedRange.RefersToRange
    On Error GoTo 0
    
    If Not targetRange Is Nothing And targetRange.Parent.Name = resizeSh.Name And targetRange.Rows.Count = 1 Then
        ' 复制当前单行到下一行
        targetRange.Copy Destination:=targetRange.Offset(1, 0)
        ' 把命名区域扩展为2行（如果需要多次复制，也可以改成循环）
        namedRange.RefersTo = targetRange.Resize(2)
    End If
Next namedRange

为什么原来的代码不行？ #

你原来用的resizeSh.Range("tablename").End(xlUp).Offset(1, 0)，本质是从tablename的位置往上找最后一个非空单元格，再往下偏移一行——如果tablename下方还有其他命名区域的内容，这个逻辑会直接跳到整个列的最后空白行，而不是tablename的直接下方，这就完全偏离了你的需求。

用Offset(targetRange.Rows.Count, 0)就精准多了，它直接以当前命名区域的范围为基准，往下偏移对应的行数，完全不受其他区域影响。

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