Help! Can someone fix my SendEmailOnClick marco??

Hi all

I have this marco with a number of shapes that click and work perfectly except that when I expanded a particular table and added another shape for this click marco it now doesn't work on any of the shapes! Can't work out why. It doesn't even get as far as saving.

Any suggestions??

It highlights here: ThisWorkbook.SaveAs Filename:="C:\Completed Project Reviews\" & Range("AI1").Value & "\" & Range("AH1").Value & ".xls"

Sub SendEmailOnButtonClick()
      Dim KeyCells As Object

      Dim Send_Email_Current_Workbook() As Range
        ' The variable KeyCells contains the cells that will
        ' cause an alert when they are changed.
        Set KeyCells = Range("A2:AE66")
        If Not Application.Intersect(KeyCells, ActiveCell) Is Nothing Then
            'Send_Email_Current_Workbook()
            Sheets("STEP 3").Select
            On Error Resume Next
            MkDir "C:\Completed Project Reviews\"
            On Error GoTo 0
            On Error Resume Next
            MkDir "C:\Completed Project Reviews\" & Range("AI1").Value
            On Error GoTo 0
            ThisWorkbook.SaveAs Filename:="C:\Completed Project Reviews\" & Range("AI1").Value & "\" & Range("AH1").Value & ".xls"
            Dim OutApp As Object
            Dim OutMail As Object
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = Range("Recip")
                .Subject = Range("(AG1)").Value
                .Body = "Please Find Attached updated Project" & " " & "for" & " " & Range("AF1").Value
                .Attachments.Add ActiveWorkbook.FullName
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
        Else
            MsgBox "Email NOT SENT. Make sure the active cell is on the report." & vbCrLf & _
                   "The active cell is '" & ActiveCell.Address(False, False) & "'."
        End If
        
      'Clear object pointers
      Set KeyCells = Nothing
End Sub