Excel跨工作簿复制行问题：含"PROGRAM"的行未被复制

嘿，我来帮你搞定这两个问题，咱们一步步来拆解：

一、把指定行复制到新建的工作簿 #

要实现这个功能，核心是先创建新工作簿，再把筛选好的行复制过去。这里给你清晰的实现思路和代码示例：

1. 先创建新工作簿并获取目标工作表：

   ' 创建新工作簿，默认自带一个Sheet1
   Dim newWB As Workbook
   Set newWB = Workbooks.Add
   Dim targetWS As Worksheet
   Set targetWS = newWB.Sheets(1)
   

2. 复制行到目标工作表：
   如果你是逐行判断后复制，可以直接在判断逻辑里完成粘贴操作；如果想高效批量复制，也可以用筛选功能。两种方式的代码示例如下：

   逐行复制版：

   Dim sourceWS As Worksheet
   Set sourceWS = ThisWorkbook.Sheets("你的源工作表名称") ' 替换成你的源表名
   Dim lastRow As Long
   lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row ' 假设数据在A列，按需调整
   Dim targetRow As Long
   targetRow = 1 ' 目标表从第一行开始粘贴
   
   ' 遍历源表行
   For i = 1 To lastRow
       ' 这里加入判断条件（后面会解决PROGRAM的问题）
       If sourceWS.Cells(i, "A").Value = inputVar Or sourceWS.Cells(i, "A").Value = "PROGRAM" Then
           ' 复制整行到目标表的targetRow行
           sourceWS.Rows(i).Copy Destination:=targetWS.Rows(targetRow)
           targetRow = targetRow + 1 ' 目标行下移，准备下一次粘贴
       End If
   Next i
   

   批量筛选复制版（更高效）：

   ' 先筛选源表
   sourceWS.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=inputVar, Operator:=xlOr, Criteria2:="PROGRAM"
   ' 复制筛选后的可见行（跳过表头的话就从A2开始）
   sourceWS.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=targetWS.Rows(1)
   ' 取消筛选
   sourceWS.AutoFilterMode = False
   

二、为什么没复制包含"PROGRAM"的行？ #

大概率是你的判断逻辑只匹配了输入变量的行，没把"PROGRAM"的情况加进去。常见的原因和解决办法：

• 判断条件遗漏：原来的代码可能只有If cell.Value = inputVar Then，没加Or cell.Value = "PROGRAM"。像上面示例那样，用Or连接两个条件就能同时匹配两种情况。
• 大小写不匹配：如果单元格里是"program"（小写）而你判断的是"PROGRAM"（大写），会匹配失败。可以用UCase统一转大写判断：

  If UCase(sourceWS.Cells(i, "A").Value) = UCase(inputVar) Or UCase(sourceWS.Cells(i, "A").Value) = "PROGRAM" Then
  

• 单元格是公式返回值：如果单元格里是公式（比如=B1&C1），直接判断cell.Value没问题，但如果是公式返回的空值或特殊格式，试试用cell.Text或者cell.Value2匹配。
• 行号范围错误：比如你遍历的行数没包含有"PROGRAM"的那一行，检查lastRow的计算是否正确，确保覆盖了所有数据行。

完整示例代码 #

把上面的逻辑整合起来，一个完整的VBA子程序大概是这样：

Sub CopyRowsToNewWB()
    Dim inputVar As String
    inputVar = InputBox("请输入要匹配的变量值：") ' 假设你用输入框获取变量
    
    Dim sourceWS As Worksheet
    Set sourceWS = ThisWorkbook.Sheets("源数据") ' 替换成你的源工作表名
    Dim lastRow As Long
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
    
    ' 创建新工作簿
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    Dim targetWS As Worksheet
    Set targetWS = newWB.Sheets(1)
    targetWS.Name = "筛选结果" ' 给目标表改个直观的名字
    
    Dim targetRow As Long
    targetRow = 1
    ' 复制表头（如果没有表头就删掉这段）
    sourceWS.Rows(1).Copy Destination:=targetWS.Rows(targetRow)
    targetRow = targetRow + 1
    
    ' 遍历并复制符合条件的行
    For i = 2 To lastRow ' 从第2行开始，跳过表头
        Dim cellValue As String
        cellValue = Trim(sourceWS.Cells(i, "A").Value) ' 去掉前后空格，避免匹配失败
        If cellValue = inputVar Or cellValue = "PROGRAM" Then
            sourceWS.Rows(i).Copy Destination:=targetWS.Rows(targetRow)
            targetRow = targetRow + 1
        End If
    Next i
    
    MsgBox "复制完成！新工作簿已创建。"
End Sub

你可以根据实际情况调整工作表名称、数据列（比如把"A"改成你的目标列），还有表头的处理（如果没有表头就去掉复制表头的代码）。

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