It is not saving correctly, in need of help to correct it

[Mfana]

Sub SavNewInvWithNewName()
Dim NewFN As Variant


' Copy New Invoice to a new workbook
ActiveSheet.Copy
NewFN = "C:\Documents\HOUSING" & Range("I7").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlXMLSpreadsheet
ActiveWorkbook.Close
NextInvoice
End Sub

 

[Logit]

.

Option Explicit


Sub CreateNewDataBase()
Dim MyFolder As String
Dim fname As String, ext As String
Dim TempFolder As String


   MkDir "C:\Users\My\Documents\HOUSING\"           '<-- Edit path as required
   MyFolder = "C:\Users\My\Documents\HOUSING\"       '<-- Edit path as required
   If MyFolder = "" Then Exit Sub
   fname = Range("I7").Value & ".xlsx"


    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=MyFolder & fname, _
         CreateBackup:=False
    ActiveWorkbook.Close False
    
    On Error Resume Next
    On Error GoTo 0
MsgBox "Done!"
End Sub

Edit paths as required for your system.

 

[Mfana]

Thanks for your contribution, however, the case in point is access denied having configured correctly or maybe one is missing out. Please help.

Sub CreateNewDataBase()
Dim MyFolder As String
Dim fname As String, ext As String
Dim TempFolder As String




MkDir "C:\Users\User\Documents\HOUSING"
MyFolder = "C:\Users\User\Documents\HOUSING"
If MyFolder = "" Then Exit Sub
fname = Range("I7").Value & ".xlsx"




ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=MyFolder & fname, _
CreateBackup:=False
ActiveWorkbook.Close False

On Error Resume Next
On Error GoTo 0
MsgBox "Done!"
End Sub

 

[Logit]

.

MkDir "C:\Users\My\Documents\HOUSING\"          [COLOR=#ff0000][B] '<-- Edit path as required[/B][/COLOR]
   MyFolder = "C:\Users\My\Documents\HOUSING\"       [COLOR=#ff0000][B]'<-- Edit path as required[/B][/COLOR]

Change the path to fit your computer as I indicated in my original post.