Save Worksheets As New File To Specific Folder

[Admin]

Hi

try this.

Option Explicit

Sub kTest()
    
    Dim strDesktopFolder    As String
    Dim strCity             As String
    Dim wbkActive           As Workbook
    Dim wbkNew              As Workbook
    Dim strFName            As String
    
    'strDesktopFolder = CreateObject("WScript.Shell").Specialfolders(10)
    
    Dim strFolderToSave     As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFolderToSave = .SelectedItems(1)
        Else
            'no folder selected
            Exit Sub
        End If
    End With
    
    strCity = ThisWorkbook.Worksheets("Sheet2").Range("c5")
    
    Set wbkActive = ThisWorkbook
    Set wbkNew = Workbooks.Add(xlWBATWorksheet)
    wbkActive.Worksheets(Array("Sheet2", "Sheet3")).Copy before:=wbkNew.Worksheets(1)
    strFName = Application.InputBox("File Name", "FileName", Type:=2)
    'wbkNew.SaveAs strDesktopFolder & "C:\Users\dracon_\Desktop\Countries" & strCity & "\" & strFName, 51 'I put my path to the folder but does
    wbkNew.SaveAs strFolderToSave & "\" & strFName, 51
                                                                                                    ' not want to get probably
                                                                                                    ' wrong again!? Please help me.
                                                                                                    ' My heartfelt thanks!
    wbkNew.Close 0
    Set wbkNew = Nothing
    
End Sub