Sub CopyRows()
For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets("Sheet2")
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & "" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & "" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next
End Sub