从工作表复制指定行到新工作簿时rng union失效问题求助

嘿，我明白你遇到的麻烦了——你的For循环里Union方法没有明确绑定源工作表，导致代码不小心把新工作簿里的内容当成了目标范围，自然复制错了对象。别担心，咱们一步步修正：

问题核心原因 #

当你新建工作簿后，Excel会自动激活这个新工作簿，如果你的代码里没有明确指定源工作表的引用，Union就会默认使用当前激活的工作表（也就是新工作簿的Sheet1），这就导致了范围引用错误。

修正后的完整代码 #

下面是调整后的代码，我会标注关键的修正点：

Sub CopyTargetRows()
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim lastRow As Long
    Dim i As Long
    Dim unionRng As Range
    Dim targetProgram As String
    
    ' 定义要查找的程序名称
    targetProgram = "你的目标程序名" ' 这里替换成你要找的程序名
    
    ' 绑定源工作表（关键！明确指定来源）
    Set wsSource = ThisWorkbook.Worksheets("你的源工作表名") ' 替换成实际的源表名称
    
    ' 获取源工作表最后一行有值的行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "你要查找的列号").End(xlUp).Row ' 比如查找B列就写"B"
    
    ' 初始化Union范围
    Set unionRng = Nothing
    
    ' 遍历源工作表的行
    For i = 1 To lastRow ' 假设表头在第1行，若表头在其他行就改成对应的起始行
        ' 检查当前行是否匹配目标程序
        If wsSource.Cells(i, "你要查找的列号").Value = targetProgram Then
            ' 明确引用源工作表的A到CV列，添加到Union范围（关键修正点）
            If unionRng Is Nothing Then
                Set unionRng = wsSource.Range("A" & i & ":CV" & i)
            Else
                Set unionRng = Union(unionRng, wsSource.Range("A" & i & ":CV" & i))
            End If
        End If
    Next i
    
    ' 如果找到匹配的行，就复制到新工作簿
    If Not unionRng Is Nothing Then
        ' 新建工作簿
        Set wbNew = Workbooks.Add
        ' 复制到新工作簿的第一个工作表的A1位置
        unionRng.Copy Destination:=wbNew.Worksheets(1).Range("A1")
        ' 可选：自动调整列宽
        wbNew.Worksheets(1).Columns.AutoFit
    Else
        MsgBox "没有找到匹配的程序名称！"
    End If
    
    ' 释放对象变量
    Set wsSource = Nothing
    Set wbNew = Nothing
    Set unionRng = Nothing
End Sub

关键修正说明 #

• 明确绑定源工作表：用Set wsSource = ThisWorkbook.Worksheets("你的源工作表名")把源表固定下来，所有后续的范围引用都通过wsSource来调用，避免默认引用激活的新工作簿。
• Union范围指定源表：每次添加行到unionRng时，都用wsSource.Range("A" & i & ":CV" & i)，确保选中的是源工作表里的行，而不是新工作簿的内容。
• 初始化与判空：在循环前初始化unionRng为Nothing，每次添加时先判断是否为空，避免第一次调用Union时出错。

这样修改后，你的代码就会准确选中源工作表里匹配的行，复制到新工作簿中啦！

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