VBA - code doesn't complete to save the workbook

[wesbez]

Hi All,

The below code stops after it has used the group function, it doesn't change formula's back to automatic and doesn't save the sheet in a new workbook.

Any ideas why?

Thanks,
Wes

Sub Copy()
    
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    
    Application.Calculation = xlManual
    Worksheets("Model").Cells.Copy
    Worksheets("Store Feedback").Range("A1").Select
    Worksheets("Store Feedback").Paste
    
    With Range("A1:AV20000")
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    Application.CutCopyMode = False
    With Range("A1:AV20000")
        .Value = .Value
    End With
    Range("1:7").ClearContents
    Range("J:J,M:M,U:V,AH:AT,AY:BF").ClearContents
    ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
    
    Application.Calculation = xlAutomatic
    
    FPath = "X:\WDFE\Supply Chain\2 Beauty Category Folder\Store MDQ Review\2018\Store Feedback"
    FName = Sheets("Summary").Range("STORE_NAME") & Format(Date, "dd-mm-yy") & ".xlsx"
 
    Set NewBook = Workbooks.Add
 
    ThisWorkbook.Sheets("Store Feedback").Copy Before:=NewBook.Sheets(1)
 
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        NewBook.SaveAs Filename:=FPath & "\" & FName
    End If
    
End Sub