Excel VBA 双关键词匹配跨表复制行 A:O列复制报错如何解决

仅复制A-O列报错的原因 #

报错的核心是复制范围和粘贴范围的列数不匹配：
你原先的代码是复制整行（Excel整行有16384列），粘贴目标也是整行，列宽完全匹配所以不会报错。当你想只复制A到O列（共15列）时，如果粘贴目标还是写Target.Rows(j)（整行），两边列数不一致就会触发运行时错误。

修复后的PMC匹配代码（仅复制A-O列）

Sub Copyrow()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("MasterDATA")
    Set Target = ActiveWorkbook.Worksheets("MainData")

    ' 优化：直接从Target表最后一行后开始追加，不需要手动指定j起始值，避免覆盖已有数据
    j = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row + 1

    For Each c In Source.Range("F1:F20000")
        If c.Value = "PMC" Then
            ' 仅复制当前行A到O列范围
            Source.Range("A" & c.Row & ":O" & c.Row).Copy
            ' 粘贴目标对应从A列开始的位置，列宽和复制范围匹配
            Target.Range("A" & j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            j = j + 1
        End If
    Next c

    ' 明确指定操作Target表的H列，避免代码运行时激活其他表导致范围错误
    With Target.Range("H1:H" & j - 1)
        .NumberFormat = "General"
        .Value = .Value
    End With

    ' 清空剪贴板，避免复制选框残留
    Application.CutCopyMode = False
End Sub

双关键词匹配追加数据功能实现 #

针对你需要的「Sheet2行匹配TREE、WOOD两个关键词后，追加A-R列到Sheet1末尾」的需求，代码如下（可根据实际业务调整匹配列的参数）：

Sub MatchAndAppend()
    Dim sourceSheet As Worksheet ' 上传数据表Sheet2
    Dim masterSheet As Worksheet ' 主数据表Sheet1(MasterDATA)
    Dim lastRowSource As Long, lastRowMaster As Long
    Dim i As Long
    ' 以下两个常量是Sheet2中存放对应关键词的列，可根据实际表格结构修改
    Const TREE_MATCH_COLUMN As Integer = 2 ' 示例：Sheet2中匹配TREE的列号
    Const WOOD_MATCH_COLUMN As Integer = 3 ' 示例：Sheet2中匹配WOOD的列号

    Set masterSheet = ThisWorkbook.Worksheets("MasterDATA")
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet2")

    ' 获取Sheet2最后一行，避免遍历无效空行
    lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    For i = 1 To lastRowSource
        ' 判断当前行两个关键词同时匹配
        If sourceSheet.Cells(i, TREE_MATCH_COLUMN).Value = "TREE" And _
            sourceSheet.Cells(i, WOOD_MATCH_COLUMN).Value = "WOOD" Then
            ' 取主表最新的最后一行行号
            lastRowMaster = masterSheet.Cells(masterSheet.Rows.Count, "A").End(xlUp).Row + 1
            ' 复制Sheet2当前行A-R列的数值和格式到主表末尾
            sourceSheet.Range("A" & i & ":R" & i).Copy
            masterSheet.Range("A" & lastRowMaster).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End If
    Next i

    Application.CutCopyMode = False
End Sub

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