VBA复制勾选复选框行异常：未勾选行也被复制求排查

问题根源 #

1. 目标表旧数据未清除：代码仅复制表头，未清理目标表表头下方的原有数据，之前运行残留的内容会被误认为是本次复制的未勾选行。
2. 目标行起始值错误：原代码把目标表的起始行设为源表最后一行+1，导致新数据从目标表靠后的位置写入，前面的旧数据保留，造成“未勾选行被复制”的错觉。
3. 未限定工作表的Range引用：Range("A" & ChkBx.TopLeftCell.Row)未指定工作表，若运行时激活的不是源表Top100，会错误复制其他工作表的行数据。

修复后的代码 #

Sub Copy_to_new_sheet()
    Dim Row1 As Long, ChkBx As CheckBox, WS1 As Worksheet, WS2 As Worksheet
    Set WS1 = Worksheets("Top100") '源工作表
    Set WS2 = Worksheets("Top100_Extract") '目标工作表
    
    ' 清空目标表表头以外的旧数据
    WS2.Rows("2:" & WS2.Rows.Count).ClearContents
    
    ' 复制表头到目标表
    WS1.Rows(1).Copy
    WS2.Rows(1).PasteSpecial xlPasteValues
    
    ' 目标行从第2行开始（表头已占第1行）
    Row1 = 2
    
    ' 遍历源表的所有复选框
    For Each ChkBx In WS1.CheckBoxes
        If ChkBx.Value = 1 Then ' 仅处理已勾选的复选框
            ' 复制对应行到目标表，明确指定源表WS1
            WS2.Cells(Row1, "A").Resize(, 14).Value = WS1.Range("A" & ChkBx.TopLeftCell.Row).Resize(, 14).Value
            Row1 = Row1 + 1 ' 目标行下移
        End If
    Next
    
    ' 清除剪贴板内容，避免弹窗提示
    Application.CutCopyMode = False
End Sub

修复说明 #

• 新增旧数据清除逻辑，确保每次运行只保留本次复制的内容。
• 修正目标行起始值，从第2行开始写入新数据，对应表头位置。
• 明确指定Range所属的源工作表，避免激活其他表时出错。
• 移除对ActiveSheet的依赖，直接遍历源表的复选框，操作更可靠。
• 新增剪贴板清理代码，消除后续操作的弹窗干扰。

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