VBA Opening Save Window Despite Events and Alerts Being Off - excel

Question

All I am trying to do is save one sheet out of the workbook to a new workbook in the same folder.
But every time I run my code, excel interrupts the execution and opens up the Save As window where you have to select the folder and name of the file, which I have never seen before.
Any Ideas on how to circumvent this? I have Events and Alerts off.
Code:
Sub Export_Data()
Dim ws As Worksheet, wb As Workbook
Dim name As String
Dim lcol As Double, lrow As Double
Dim path As String
Set ws = ThisWorkbook.Worksheets("EMPLOYEES")
Application.DisplayAlerts = False
Application.EnableEvents = False
path = "C:\Users\PATH\"
Set wb = Workbooks.Add
ws.Copy Before:=wb.Sheets(1)
On Error Resume Next ' Need this because I get a runtime error 1004, though it still saves it regardless
wb.SaveAs Filename:=path & "People_Data" & ".xlsx", FileFormat:=51 '''' Here is where it opens the save as window??????
wb.Sheets("Sheet1").Delete
wb.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Answer 1

Save a Worksheet to a New Workbook
If nothing else, this should shed some light on what's going on. Your feedback is expected.
Sub SaveWorksheetToNewWorkbook()
Const ProcName As String = "SaveWorksheetToNewWorkbook"
Dim Success As Boolean
On Error GoTo ClearError
Const SOURCE_WORKSHEET_NAME As String = "EMPLOYEES"
Const DESTINATION_FOLDER_PATH As String = "C:\Test"
Const DESTINATION_FILE_NAME As String = "People_Data.xlsx"
Application.ScreenUpdating = False
' Check if the destination path exists.
Dim pSep As String: pSep = Application.PathSeparator
Dim dFolderPath As String: dFolderPath = DESTINATION_FOLDER_PATH
If Right(dFolderPath, 1) <> pSep Then dFolderPath = dFolderPath & pSep
Dim dFolderName As String: dFolderName = Dir(dFolderPath, vbDirectory)
If Len(dFolderName) = 0 Then
MsgBox "The path '" & dFolderPath & "' doesn't exist.", _
vbExclamation, ProcName
Exit Sub
End If
Dim dwb As Workbook
' Check if the destination workbook, or a workbook with the same name,
' is open.
On Error Resume Next
Set dwb = Workbooks(DESTINATION_FILE_NAME)
On Error GoTo ClearError
If Not dwb Is Nothing Then
If StrComp(dwb.Path & pSep, dFolderPath, vbTextCompare) = 0 Then
MsgBox "The destination workbook '" & DESTINATION_FILE_NAME _
& "' is open." & vbLf & "Close it and try again.", _
vbExclamation, ProcName
Else
MsgBox "A workbook with the same name as the destination file ('" _
& DESTINATION_FILE_NAME & "') is open." _
& vbLf & "Close it and try again.", vbExclamation, ProcName
End If
Exit Sub
End If
' Export the worksheet.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = swb.Worksheets(SOURCE_WORKSHEET_NAME)
sws.Copy ' creates a copy as a new single-worksheet workbook
Set dwb = Workbooks(Workbooks.Count)
Dim ErrNumber As Long
Dim ErrDescription As String
Application.DisplayAlerts = False ' overwrite without confirmation
On Error Resume Next
dwb.SaveAs dFolderPath & DESTINATION_FILE_NAME
ErrNumber = Err.Number
ErrDescription = Err.Description
On Error GoTo ClearError
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False ' just got saved
If ErrNumber <> 0 Then
MsgBox "' Run-time error '" & ErrNumber & "':" & vbLf _
& ErrDescription & vbLf & vbLf _
& "This error occurred while attempting to save the workbook.", _
vbCritical, ProcName
Exit Sub
End If
Success = True
ProcExit:
On Error Resume Next
If Success Then
MsgBox "Worksheet saved to new workbook.", vbInformation, ProcName
End If
On Error GoTo 0
Exit Sub
ClearError:
MsgBox "' Run-time error '" & Err.Number & "':" & vbLf _
& Err.Description & vbLf & vbLf _
& "This error occurred quite unexpectedly.", _
vbCritical, ProcName
Resume ProcExit
End Sub