Selection.Insert/Insert Copied Cells Not Working

[BellaEC]

Hi,

Please see workbook at following link, SWMS.xlsm - Speedy Share - upload your files here

ExpireBox
I think either link should work (fingers crossed)

I have a workbook "SWMs.xlsm" with 2 tabs, "Template" & "RiskRegister". I have 31 checkboxes on "Template" that filter a table on "RiskRegister".
Once a button is clicked I copy the template tab to a new workbook, rename, delete all the checkboxes & associated rows & insert the filtered table into cell A18 on the newly created workbook.
It did work once, but only once? Also when I have all the checkboxes unticked it does copy & paste (now insert) all 980so rows to cell A18 but that pastes over data I need, it's not inserting & shift down, it's just pasting over.

I tried to recreate the macro but my insert copied cells is not displaying at all now, I have checked the name manager to see if anything is wrong in there, seems fine, I checked both advanced options of displaying all objects & advenced options under cut,copy,paste of show inserts so I am stumped, could any excel/vba whizzes out there please assist?

Also the code seems very slow to execute, would you have any tips to speed up?

I've copied & pasted the code below as well in case my link above doesn't work as planned.

Sub Filter_Me()
    Dim LR As Long
    Dim i As Integer
    Dim objcBox As Object
    Dim cBox() As Variant
 
    Application.ScreenUpdating = False
    
        For Each objcBox In ThisWorkbook.Worksheets("Template").OLEObjects
             If TypeName(objcBox.Object) = "CheckBox" Then
                If objcBox.Object.Value Then
                    ReDim Preserve cBox(i)
                   cBox(i) = objcBox.Object.Caption
                    i = i + 1
                End If
            End If
        Next
    With Sheets("RiskRegister")
            .AutoFilterMode = False
            
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
            .Range("A1").AutoFilter
            If Len(Join(cBox)) > 0 Then
                .Range("A1:I" & LR).AutoFilter Field:=1, Criteria1:=Array(cBox), Operator:=xlFilterValues
            Else
               ' MsgBox "Nothing Selected", 48, "Nothing Selected"
            End If
    End With
    Application.ScreenUpdating = True
End Sub

Sub CopySWMs()

    Dim fName As String

    Application.ScreenUpdating = False

    fName = Sheets("Template").Range("B1").Text

        Sheets("Template").Select
        Sheets("Template").Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs filename:="E:\Risk Register\Tests\" & fName & " " & Format(Date, "ddmmyyyy") & ".xls", FileFormat:=56
        
        ActiveSheet.Shapes.Range(Array("CheckBox1", "CheckBox2", "CheckBox3", "CheckBox4", "CheckBox5", "CheckBox6", "CheckBox7", _
        "CheckBox8", "CheckBox9", "CheckBox10", "CheckBox11", "CheckBox12", "CheckBox13", "CheckBox14", "CheckBox15", _
        "CheckBox16", "CheckBox17", "CheckBox18", "CheckBox19", "CheckBox20", "CheckBox21", "CheckBox22", "CheckBox23", _
        "CheckBox24", "CheckBox25", "CheckBox26", "CheckBox27", "CheckBox28", "CheckBox29", "CheckBox30", "CheckBox31")). _
        Select
        Selection.Delete

        ActiveSheet.Shapes.Range(Array("cmdSWMS")).Select
        Selection.Delete
        
        Rows("18:36").Select
        Selection.Delete Shift:=xlUp
        Rows("18:18").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A18").Select
        
        Dim rng As Range
        Dim nrows As Integer
        Dim LR1 As Long
        
        Windows("SWMS.xlsm").Activate
        Sheets("RiskRegister").Select
        Range( _
            "Risktbl4[[#Headers],[Job steps - list tasks to perform/activities in sequence]]" _
            ).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        
        Application.Workbooks(2).Activate
        Sheets("Template").Activate
        Range("A18:H18").Select
        Selection.Insert Shift:=xlDown
        Selection.Rows.AutoFit
        ActiveWindow.SmallScroll Down:=15
        Application.CutCopyMode = False
         
    Application.ScreenUpdating = True
  
    Workbooks("SWMS.xlsm").Activate
    Sheets("Template").Activate
    ActiveSheet.CheckBoxes.Value = False
    
End Sub

Behind template sheet - goes up to Checkbox 31, also behind RiskRegister tab.

Private Sub cmdSWMS_Click()

    Call CopySWMs
    
End Sub


Private Sub CheckBox1_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox2_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox3_Click()
    Call Filter_Me
End Sub

Thanks so much,

Eimear