選中複選框時將行復制到新工作表

Question

我試圖在複選框被選中後將所有數據從一行（從列A：O）複製到新工作表。但是，我擁有的代碼也在複製所有先前檢查過的行。我不想取消選擇任何以前選中的框。

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

Answer 1

請嘗試使用ActiveCell.Row修改後的代碼（假定最後一個複選框行已被選中/激活）。

Sub CopyRows() 
    Dim LRow As Long, r As Long, ChkBx As CheckBox, WS2 As Worksheet 
    Set WS2 = Worksheets("Sheet2") 
    r = ActiveCell.Row 
    WS2.Cells(r, "A").Resize(, 14) = Range("A" & ChkBx.TopLeftCell.Row).Resize(, 14).Value 
End Sub