Excel VBA问题：复制行至其他工作表空白行时覆盖原有内容

我明白你的需求：当"New Refs"工作表的L列单元格值为"Yes"时，触发代码检查M-T列是否存在"Yes"，并把当前行复制到对应的工作表（比如M列是"Yes"就复制到"ASD 5P"），但之前的代码会覆盖目标表的已有内容，需要改成追加到下一个空白行。

修改后的完整代码 #

把这段代码粘贴到"New Refs"工作表的代码模块里（右键工作表标签→查看代码）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只处理L列的单元格变化，其他列修改不触发代码
    If Intersect(Target, Me.Range("L:L")) Is Nothing Then Exit Sub
    
    ' 关闭事件触发，避免复制行时重复触发Change事件导致混乱
    Application.EnableEvents = False
    
    Dim currentRow As Long
    Dim targetWs As Worksheet
    Dim lastBlankRow As Long
    Dim col As Integer
    
    ' 遍历所有触发变化的单元格（支持批量修改L列的场景）
    For Each cell In Target
        currentRow = cell.Row
        
        ' 确认当前行L列确实是"Yes"（不区分大小写）
        If UCase(Me.Cells(currentRow, "L").Value) = "YES" Then
            ' 遍历M到T列（对应列号13到20）
            For col = 13 To 20
                If UCase(Me.Cells(currentRow, col).Value) = "YES" Then
                    ' 根据列号映射到对应的目标工作表，你需要按需补充完整映射
                    Select Case col
                        Case 13 ' M列
                            Set targetWs = ThisWorkbook.Worksheets("ASD 5P")
                        Case 14 ' N列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称1")
                        Case 15 ' O列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称2")
                        Case 16 ' P列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称3")
                        Case 17 ' Q列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称4")
                        Case 18 ' R列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称5")
                        Case 19 ' S列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称6")
                        Case 20 ' T列
                            Set targetWs = ThisWorkbook.Worksheets("对应工作表名称7")
                    End Select
                    
                    ' 找到目标工作表A列的下一个空白行（从最后一行往上找非空行，再加1）
                    lastBlankRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1
                    
                    ' 复制当前行到目标工作表的空白行
                    Me.Rows(currentRow).Copy Destination:=targetWs.Rows(lastBlankRow)
                    
                    ' 如果只需要复制值（不需要格式/公式），可以替换成下面两行：
                    ' Me.Rows(currentRow).Copy
                    ' targetWs.Rows(lastBlankRow).PasteSpecial Paste:=xlPasteValues
                End If
            Next col
        End If
    Next cell
    
    ' 重新开启事件触发，恢复正常工作表事件响应
    Application.EnableEvents = True
End Sub

关键修改点说明 #

• 定位空白行：用targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1精准找到目标表的下一个空白行，彻底避免覆盖已有数据。这个逻辑是从A列最后一行向上查找第一个非空单元格，其下一行就是空白行。
• 避免循环触发：开头关闭Application.EnableEvents，防止复制行时触发目标工作表的Change事件，导致代码重复执行或出错，最后必须重新开启。
• 多列映射适配：通过Select Case col把M-T列（列号13到20）和目标工作表一一对应，你只需要替换示例中的工作表名称即可。
• 支持批量操作：用For Each cell In Target循环处理批量修改L列的场景，比如一次性填充多个单元格为"Yes"时也能正常工作。

注意事项 #

1. 确保目标工作表的名称和代码里的完全一致，包括大小写、空格和特殊字符。
2. 如果只需要复制单元格的值而不需要格式、公式等，可以使用代码中注释的PasteSpecial版本。
3. 测试前记得保存工作簿，避免代码调试时的意外导致数据丢失。

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