如何在VBA中基于计数器变量引用命名区域中动态变化的指定行？

以下是完全匹配你需求的VBA代码，核心逻辑严格遵循逐行校验、复制的流程：

Sub 遍历命名区域复制行()
    Dim sourceNamedRng As Range
    Dim targetWorkbook As Workbook
    Dim targetSheet As Worksheet
    Dim i As Long
    Dim rngTotalRows As Long
    
    ' --------------------------
    ' 请修改以下参数为实际值
    ' --------------------------
    ' 替换为你的命名区域名称
    Set sourceNamedRng = ThisWorkbook.Names("你的命名区域名").RefersToRange
    ' 替换为你的目标工作簿名称（运行宏前需提前打开）
    Set targetWorkbook = Workbooks("目标工作簿.xlsx")
    ' 替换为你的目标工作表名称
    Set targetSheet = targetWorkbook.Sheets("Sheet1")
    ' 初始化计数器
    i = 1
    ' 读取命名区域总行数，自动适配动态范围
    rngTotalRows = sourceNamedRng.Rows.Count
    
    ' 循环遍历逻辑
    Do While i <= rngTotalRows
        ' 校验当前行是否有内容：非空单元格数量大于0即判定为存在内容
        If WorksheetFunction.CountA(sourceNamedRng.Rows(i)) > 0 Then
            ' 复制当前行到目标工作表的末尾空白行
            sourceNamedRng.Rows(i).Copy _
                Destination:=targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
            
            ' 若仅需粘贴值不需要格式，注释掉上面的复制代码，启用以下两行：
            ' sourceNamedRng.Rows(i).Copy
            ' targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
        ' 计数器自增，进入下一行循环
        i = i + 1
    Loop
    
    ' 清空剪贴板缓存
    Application.CutCopyMode = False
End Sub

• 命名区域的总行数通过sourceNamedRng.Rows.Count自动获取，不需要手动修改，哪怕后续命名区域的范围调整也能正常适配
• 内容校验用的CountA函数会统计行内所有非空单元格，避免空行被误复制
• 目标粘贴位置自动取目标工作表第一列的最后一个非空行的下一行，不会覆盖已有数据

• 如果命名区域不在当前运行宏的工作簿里，把ThisWorkbook替换为对应工作簿的对象即可，比如Workbooks("源数据.xlsx")
• 如果需要调整粘贴的起始列，把targetSheet.Rows.Count, 1里的1改成对应的列号即可，比如2对应B列

内容的提问来源于stack exchange，提问作者E.Cash