How to get the save file box to open when running this macro

I have done this before but haven't tested this exact code. If it doesn't work, be specific about what doesn't work.

    Dim FilePath As String

    'Get path for desktop of user PC
    Path = Environ("USERPROFILE")
    ActiveSheet.Range("F4:M" & Range("F" & Rows.Count).End(xlUp).Row).Copy            '<-- Adjust range here
   
    'Create new workbook and past copied data in new workbook & save to desktop
    Workbooks.add (xlWBATWorksheet)
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    ActiveWorkbook.ActiveSheet.Name = "Sheet1"
    FilePath = Application.GetSaveAsFilename _
    (InitialFileName:=sFile, _
        FileFilter:="Excel Files (*.xlsx), *.xlsx", _
        Title:="Select Folder and File Name to save")
    If FilePath = "" Then
        MsgBox "No file selected, file not saved."
    Else
       ActiveWorkbook.SaveAs Filename:=FilePath
       ActiveWorkbook.Close SaveChanges:=True
    End If

Hey 6StringJazzer... Thank you!

It's almost perfect. The only thing that seems odd... is a blank spreadsheet opens up in front of my workbook and then the save dialogue box opens in front of the blank spreadsheet. Once I click save the blank spreadsheet closes along with the dialogue box. Not sure if that is what is supposed to happen or if there is a way to only have the dialogue box open and not have the blank spreadsheet open also?

Also notice that if you click "Cancel" on the dialogue box it still saves the spreadsheet with the name FALSE.

Thanks again!

I'm not sure why you would see a blank spreadsheet. I have not seen that happen. If you attach your actual file I can try it.

Make this change to deal with the Cancel scenario:

    Dim FilePath As Variant

    'Get path for desktop of user PC
    Path = Environ("USERPROFILE")
    ActiveSheet.Range("F4:M" & Range("F" & Rows.Count).End(xlUp).Row).Copy            '<-- Adjust range here
   
    'Create new workbook and past copied data in new workbook & save to desktop
    Workbooks.add (xlWBATWorksheet)
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    ActiveWorkbook.ActiveSheet.Name = "Sheet1"
    FilePath = Application.GetSaveAsFilename _
    (InitialFileName:=sFile, _
        FileFilter:="Excel Files (*.xlsx), *.xlsx", _
        Title:="Select Folder and File Name to save")
    If FilePath <> False Then
        MsgBox "No file selected, file not saved."
    Else
       ActiveWorkbook.SaveAs Filename:=FilePath
       ActiveWorkbook.Close SaveChanges:=True
    End If

I played around with it and after moving somethings around it now works perfect. Adding the screen updating seems to be what stopped the sheet from opening. Thank you again for the help! Here is the final code I ended up with...

     Dim Path As Variant

     Application.ScreenUpdating = False

    'Get path for desktop of user PC
    FilePath = Application.GetSaveAsFilename _
    (InitialFileName:=ThisWorkbook.Path & "\" & "NEW_" & Format(CStr(Now()), "yyyymmdd\_hhmm") & ".xlsx", _
        FileFilter:="Excel Files (*.xlsx), *.xlsx", _
        Title:="Select Folder and File Name to save")
    If FilePath <> "False" Then
    Path = Environ("USERPROFILE")
    ActiveSheet.Range("F4:M" & Range("F" & Rows.Count).End(xlUp).Row).Copy            '<-- Adjust range here
   
    'Create new workbook and past copied data in new workbook & save to desktop
    Workbooks.add (xlWBATWorksheet)
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    ActiveWorkbook.ActiveSheet.Name = "Sheet1"
    ActiveWorkbook.SaveAs Filename:=FilePath
    ActiveWorkbook.Close SaveChanges:=True

    End If

    Application.ScreenUpdating = True