VBA勾选复选框复制对应单元格到另一工作表异常求解

问题原因 #

原代码每次执行.Copy操作都会覆盖剪贴板的已有内容，因此仅会保留最后一个被勾选复选框对应的区域，无法实现多区域同时复制。

优化后代码 #

直接替换原有代码即可，已实现多选中区域合并复制、粘贴到另一工作表的需求：

Private Sub CommandButton1_Click()
    Dim targetRng As Range
    Dim pasteSht As Worksheet
    
    ' 定义粘贴目标工作表，可修改为你实际的表名
    Set pasteSht = ThisWorkbook.Worksheets("Sheet2")
    
    ' 遍历所有复选框，合并选中的区域
    If CheckBox1.Value = True Then
        If targetRng Is Nothing Then
            Set targetRng = ActiveSheet.Range("B13:E18")
        Else
            Set targetRng = Union(targetRng, ActiveSheet.Range("B13:E18"))
        End If
    End If
    
    If CheckBox2.Value = True Then
        If targetRng Is Nothing Then
            Set targetRng = ActiveSheet.Range("B20:E25")
        Else
            Set targetRng = Union(targetRng, ActiveSheet.Range("B20:E25"))
        End If
    End If
    
    If CheckBox3.Value = True Then
        If targetRng Is Nothing Then
            Set targetRng = ActiveSheet.Range("B27:E32")
        Else
            Set targetRng = Union(targetRng, ActiveSheet.Range("B27:E32"))
        End If
    End If
    
    If CheckBox4.Value = True Then
        If targetRng Is Nothing Then
            Set targetRng = ActiveSheet.Range("B34:E39")
        Else
            Set targetRng = Union(targetRng, ActiveSheet.Range("B34:E39"))
        End If
    End If
    
    ' 有选中区域则执行复制粘贴
    If Not targetRng Is Nothing Then
        targetRng.Copy
        ' 粘贴到目标表的A1单元格，可修改为你需要的起始位置
        pasteSht.Range("A1").PasteSpecial Paste:=xlPasteAll
        ' 清除剪贴板
        Application.CutCopyMode = False
    End If
End Sub

注意事项 #

• 代码中"Sheet2"为默认目标工作表名，可替换为你实际使用的工作表名称
• 粘贴起始位置Range("A1")可根据需求调整
• 需要新增更多复选框时，按现有If分支的格式添加对应区域即可
• 如果需要仅粘贴数值/格式，可修改Paste:=xlPasteAll参数，常用参数包括xlPasteValues（仅粘贴数值）、xlPasteFormats（仅粘贴格式）

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