将带有勾选复选框的行复制到vba中的新工作表答案

【问题标题】：Copy rows with ticked checkboxes to a new sheet in vba将带有勾选复选框的行复制到vba中的新工作表
【发布时间】：2022-09-24 01:05:54
【问题描述】：

我尝试了这段代码，但它似乎排除了标题并将内容粘贴到同一张表中。

Sub Copy_to_new_sheet()
    Dim Row1 As Long, ChkBx As CheckBox, WS2 As Worksheet
    Set WS2 = Worksheets(\"Sheet1\")
    Row1 = WS2.Range(\"A\" & Rows.Count).End(xlUp).Row
    For Each ChkBx In ActiveSheet.CheckBoxes
        If ChkBx.Value = 1 Then
            Row1 = Row1 + 1
            WS2.Cells(Row, \"A\").Resize(, 14) = Range(\"A\" & _
            ChkBx.TopLeftCell.Row).Resize(, 14).Value
        End If
    Next
 End Sub

请，总是将 Option Explicit 放在代码模块的顶部。这样，您会发现拼写错误：WS2.Cells(Row, \"A\") 而不是 WS2.Cells(Row1, \"A\")。您的代码不会在那一行出现错误吗？ Excel中不存在零行...

标签： excel vba checkbox

【解决方案1】：

您的代码应如下所示

Option Explicit
Sub Copy_to_new_sheet()
    Dim Row1 As Long, ChkBx As CheckBox, WS1 As Worksheet, WS2 As Worksheet
    Set WS1 = Worksheets("Sheet1") 'Source worksheet
    Set WS2 = Worksheets("Sheet2") 'Destination worksheet
    WS1.Rows(1).Copy 'Copy header in row 1
    WS2.Rows(1).PasteSpecial xlPasteValues 'Paste header in destination worksheet
    
    Row1 = WS1.Range("A" & Rows.Count).End(xlUp).Row
    For Each ChkBx In ActiveSheet.CheckBoxes 'The sheet with ckeckboxes must be selected (ActiveSheet)
        If ChkBx.Value = 1 Then
            Row1 = Row1 + 1
            'Assign value to cell in destination sheet
            WS2.Cells(Row1, "A").Resize(, 14) = Range("A" & _
            ChkBx.TopLeftCell.Row).Resize(, 14).Value
        End If
    Next
End Sub

【讨论】：