遍历复选框提取选中行值：表格主副数据跨工作表复制需求

核心逻辑 #

1. 定位固定的主数据区域
2. 遍历当前工作表内所有复选框，筛选出已勾选的项
3. 对每个勾选项，匹配其所在行的子数据
4. 将主数据与对应子数据合并为单行，追加到目标工作表的最后一行

可直接复用的VBA代码 #

Sub CopyMainWithCheckedSubData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim mainDataRange As Range
    Dim cb As CheckBox
    Dim subDataRow As Integer
    Dim targetLastRow As Integer
    
    ' 替换成你的源工作表和目标工作表名称
    Set wsSource = ThisWorkbook.Worksheets("源表")
    Set wsTarget = ThisWorkbook.Worksheets("目标表")
    
    ' 定义主数据区域（示例：源表第1行A到D列，按需修改）
    Set mainDataRange = wsSource.Range("A1:D1")
    
    ' 遍历所有表单控件复选框
    For Each cb In wsSource.CheckBoxes
        If cb.Value = xlOn Then
            ' 获取复选框所在的子数据行
            subDataRow = cb.TopLeftCell.Row
            ' 找到目标表的下一个空行
            targetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
            
            ' 复制主数据到目标行
            mainDataRange.Copy wsTarget.Cells(targetLastRow, mainDataRange.Column)
            ' 复制对应子数据到目标行后续列（示例：源表该行E到H列，按需修改）
            wsSource.Range("E" & subDataRow & ":H" & subDataRow).Copy wsTarget.Cells(targetLastRow, mainDataRange.Columns.Count + 1)
        End If
    Next cb
    
    Application.CutCopyMode = False
    MsgBox "合并复制完成！", vbInformation
End Sub

代码调整说明 #

• 工作表名称：把代码里的"源表"和"目标表"替换成你实际的工作表名称
• 主数据范围：修改mainDataRange的单元格区域，比如主数据在第2行B到E列，就写成wsSource.Range("B2:E2")
• 子数据范围：修改复制子数据的Range，比如子数据在复选框行的F到J列，就改成wsSource.Range("F" & subDataRow & ":J" & subDataRow)
• ActiveX复选框适配：如果你的复选框是ActiveX控件，把遍历部分改成以下代码：

  Dim cb As OLEObject
  For Each cb In wsSource.OLEObjects
      If TypeName(cb.Object) = "CheckBox" And cb.Object.Value = True Then
          subDataRow = cb.TopLeftCell.Row
          ' 后续复制逻辑同上
      End If
  Next cb
  

注意事项 #

• 确保复选框和对应子数据在同一行，否则需要调整subDataRow的获取逻辑
• 运行宏前确认目标工作表已存在，且没有保护
• 如果主数据是多行（比如表头+主数据行），只需调整mainDataRange的范围即可

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