基于单元格数值条件的跨工作簿行复制VBA技术问询

需求：当本工作簿（Workbook1）的RECORDS工作表中某行N列单元格为数值时（N列是收到样本数与发出数的差值，无差值返回空），将该行复制到Extra Samples Catalog.xlsm（Workbook2）的第3个工作表。

尝试方案1：基于AutoFilter的代码 #

问题：无法正确设置IsNumeric作为筛选条件，且误将返回空值的公式单元格识别为数值，代码如下：

Sub ESWcopypaste()

    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, i As Long
    Dim R As Range

    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    Set R = Awksht.Range([A2], Range("A" & Rows.Count).End(xlUp)) ' 尝试过几种写法，但还是会把返回""的公式单元格识别为数值并包含进来...

    Workbooks.Open ("filepath to the ESW workbook")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)

    CR = ESwksht.Range("A" & Rows.Count).End(xlUp).Row ' 用来定位粘贴的空行，用AutoFilter的话可能没必要

    On Error Resume Next
        With R
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            .AutoFilter , field:=1, Criteria1:=(If IsNumeric(Range("N" & i).Value) = True)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("ESwksht").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0

End Sub

尝试方案2：条件复制粘贴代码 #

最初直接粘贴行报错（错误13：类型不匹配），修改为PasteSpecial Paste:=xlPasteValues后正常运行，但不清楚原因，可运行代码如下：

Sub CPESampleData()

    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, i As Long
    Dim R As Range

    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    Set R = Awksht.Range("A" & Rows.Count).End(xlUp)

    Workbooks.Open ("C:filepath to Extra Samples Catalog.xlsm")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)
    CR = ESwksht.Range("A" & Rows.Count).End(xlUp).Row

    AW.Activate

    With AW.Sheets("RECORDS")
        AW.Activate
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            If IsNumeric(Range("N" & i).Value) = True Then
                Awksht.Rows(i).Copy
                ESwksht.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    End With

    ESwksht.Activate

End Sub

疑问 #

1. AutoFilter的IsNumeric条件该怎么正确写？
2. 为什么修改为PasteSpecial Paste:=xlPasteValues后就不报错了？

解答 #

1. AutoFilter实现IsNumeric筛选的正确写法 #

Excel的AutoFilter本身不支持直接用IsNumeric作为筛选条件，因为它的Criteria参数只能用文本、数值或通配符规则。要实现筛选N列为数值的行，有两种可行方式：

方式一：辅助列+筛选

在RECORDS工作表新增一列（比如O列），用公式判断N列是否为数值：

=IF(AND(ISNUMBER(N1),N1<>""),1,0)

然后用AutoFilter筛选O列为1的行，代码示例：

Sub ESWcopypaste_Fixed()
    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, pasteRow As Long
    
    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    LR = Awksht.Range("A" & Rows.Count).End(xlUp).Row
    
    ' 添加辅助列
    Awksht.Range("O1").Value = "IsNumericFlag"
    Awksht.Range("O2:O" & LR).Formula = "=IF(AND(ISNUMBER(N2),N2<>""""),1,0)"
    
    ' 打开目标工作簿
    Workbooks.Open ("filepath to the ESW workbook")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)
    pasteRow = ESwksht.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    ' 筛选辅助列为1的行
    Awksht.Range("A1:O" & LR).AutoFilter Field:=15, Criteria1:="1"
    ' 复制可见行（跳过表头）
    Awksht.Range("A2:O" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
        Destination:=ESwksht.Range("A" & pasteRow)
    
    ' 清除筛选和辅助列
    Awksht.AutoFilterMode = False
    Awksht.Columns("O").Delete
    
    ESW.Save
End Sub

方式二：用VBA循环标记+筛选（不新增列）

如果不想加辅助列，可以先遍历N列，把非数值的行隐藏，再复制可见行：

Sub ESWcopypaste_NoHelper()
    Dim ESW As Workbook, AW As Workbook, Awksht As Worksheet, ESwksht As Worksheet
    Dim LR As Long, i As Long, pasteRow As Long
    
    Set AW = ThisWorkbook
    Set Awksht = AW.Worksheets("RECORDS")
    LR = Awksht.Range("A" & Rows.Count).End(xlUp).Row
    
    ' 打开目标工作簿
    Workbooks.Open ("filepath to the ESW workbook")
    Set ESW = Application.Workbooks("Extra Samples Catalog.xlsm")
    Set ESwksht = ESW.Worksheets(3)
    pasteRow = ESwksht.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    ' 隐藏非数值行
    Awksht.Rows.Hidden = False ' 先取消所有隐藏
    For i = 2 To LR
        If Not (IsNumeric(Awksht.Range("N" & i).Value) And Awksht.Range("N" & i).Value <> "") Then
            Awksht.Rows(i).Hidden = True
        End If
    Next i
    
    ' 复制可见行
    Awksht.Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
        Destination:=ESwksht.Range("A" & pasteRow)
    
    ' 取消隐藏
    Awksht.Rows.Hidden = False
    
    ESW.Save
End Sub

另外你之前的代码里，把返回""的公式单元格识别为数值，是因为IsNumeric("")会返回True，所以必须加上N列值不为空的判断：IsNumeric(Range("N" & i).Value) And Range("N" & i).Value <> ""。

2. 为什么PasteSpecial xlPasteValues能解决错误13 #

错误13（类型不匹配）通常是因为复制的内容和目标单元格的格式/数据类型冲突，或者复制操作后剪贴板内容异常。

• 直接用Copy + Destination或者Copy + Paste时，会复制单元格的所有属性：值、公式、格式、数据验证、条件格式等。如果目标工作表中某些列有数据验证规则，或者单元格格式和源单元格不兼容，就会触发类型不匹配。
• 而PasteSpecial Paste:=xlPasteValues只复制单元格的数值内容，忽略所有格式、公式和其他属性，避免了格式/规则冲突，所以不会报错。

另外你的代码里还有可以优化的地方：比如不需要频繁Activate工作簿/工作表，直接用对象引用更高效；打开工作簿时最好用完整路径，避免找不到文件。

内容的提问来源于stack exchange，提问作者Anthony Davis SF