Ok Try This
I created a few macros for you.
Have a play.
Public LR As Integer
Sub CheckboxesCreate()
LastRow ("Sheet1")
CheckboxesRemove
For Each c In Range("a7:a" & LR)
Set X = ActiveSheet.CheckBoxes.Add(c.Left, c.Top, , c.Height)
X.Characters.Text = ""
X.Top = c.Top + (c.Height - X.Height) / 2
X.Left = c.Left + 4 + (c.Width - X.Width) / 2
' X.LinkedCell = c.Offset(0, 5).Address
X.Name = Replace(c.Address(0, 0), "$", "")
Next
End Sub
Sub CheckboxesList()
On Error Resume Next
LastRow ("Sheet1")
For Count = 7 To LR
If ActiveSheet.CheckBoxes("A" & Count).Value = 1 Then
Cells(Count, 7).Value = "True"
Else
Cells(Count, 7).Value = "False"
End If
Next
On Error GoTo 0
End Sub
Sub CheckboxesSetAll()
On Error Resume Next
ActiveSheet.CheckBoxes.Value = True
On Error GoTo 0
End Sub
Sub CheckboxesClearAll()
On Error Resume Next
ActiveSheet.CheckBoxes.Value = False
On Error GoTo 0
End Sub
Sub CheckboxesRemove()
ActiveSheet.CheckBoxes.Delete
End Sub
Sub LastRow(S As String)
LR = Sheets(S).Cells(Rows.Count, 2).End(xlUp).Row
10 If Sheets(S).Cells(LR, 2) = "" Then LR = LR - 1: GoTo 10
End Sub
Sub MoveRows()
Dim MoveRange As Range
On Error Resume Next
LastRow ("Sheet1")
For Count = 7 To LR
If ActiveSheet.CheckBoxes("A" & Count).Value = 1 Then
If Flag = False Then
Flag = True: Set MoveRange = Range(Cells(Count, 2), Cells(Count, 27))
Else
Set MoveRange = Union(MoveRange, Range(Cells(Count, 2), Cells(Count, 27)))
End If
ActiveSheet.CheckBoxes("A" & Count).Delete
End If
Next
LastRow ("Sheet2")
MoveRange.Copy Destination:=Sheets("Sheet2").Cells(LR + 1, 1)
MoveRange.EntireRow.Delete
On Error GoTo 0
End Sub
Bookmarks