'Сохраняет каждый лист отмеченный чекбоксом в отдельные файлы на рабочий стол
Sub SaveWsh0()
    Dim objShape As Object
        Application.ScreenUpdating = False
        For Each objShape In ThisWorkbook.Worksheets("Лист1").DrawingObjects
            If TypeName(objShape) = "CheckBox" Then
                If objShape.Value = 1 Then
                    Worksheets(objShape.Text).Copy
                    ActiveWorkbook.SaveAs Environ("USERPROFILE") & "\Desktop\" & objShape.Text & Format(Now(), "yyyyddmm_hhnnss") & ".xlsx"
                    ActiveWorkbook.Close
                End If
            End If
        Next objShape
End Sub

'Сохраняет группу отмеченных чекбоксами листов в один файл на рабочий стол
Sub SaveWsh1()
    Dim objShape As Object, arr(), i As Long
        Application.ScreenUpdating = False
        ReDim arr(0 To 0)
        For Each objShape In ThisWorkbook.Worksheets("Лист1").CheckBoxes
                If objShape.Value = 1 Then
                    ReDim Preserve arr(0 To i)
                    arr(i) = objShape.Text
                    i = i + 1
                End If
        Next objShape
        Sheets(arr).Copy
        ActiveWorkbook.Close SaveChanges:=True, Filename:=Environ("USERPROFILE") & "\Desktop\" & Format(Now(), "yyyyddmm_hhnnss") & ".xlsx"
End Sub

Sub enstaralпрпр() 'В 1 книгу
Dim Tp1, Tp2, Tp3, kLis%, i&, j&
Application.ScreenUpdating = False
    kLis = Worksheets.Count: ReDim Tp1(1 To kLis): Tp2 = Tp1
For i = 1 To kLis: Tp1(i) = Worksheets(i).Name: Next
    For Each Tp3 In Worksheets("Лист1").CheckBoxes
If Tp3.Value = 1 And UBound(Filter(Tp1, Tp3.Text, , 1)) >= 0 Then j = j + 1: Tp2(j) = Tp3.Text
    Next: ReDim Preserve Tp2(1 To j)
Sheets(Tp2).Copy
ActiveWorkbook.Close True, ThisWorkbook.Path & "\Книга1"
End Sub