Vba to Copy ActiveWorksheet, then open SaveAs Dialog Box to pick Subfolder

[MikeL]

Hello,
I would like to copy the active worksheet, name as the current sheet name, then have the dialog box for save as open with a choice of subfolders under C:\test\

here is the start of my code

Dim FileName As String
Dim FolderName As String

ActiveSheet.Copy
FileName = ActiveSheet.Name
FolderName = BrowseFolder(Caption:="Select A Folder", InitialFolder:="C:\test")

How to complete this to saveas an .xlsm format under the subfolder selected?

Thanks

 

[puru.sve]

Hi Mike,,, try this

Sub ActiveCopy()
Dim FileName As String
Dim FolderName As String
Dim fPth As Object
Dim fPath As String
ActiveSheet.Copy
FileName = ActiveSheet.Name
Set fPth = Application.FileDialog(msoFileDialogFolderPicker)
        
        With fPth
            .InitialFileName = "C:\test\"
            .Title = "Select Data File :"
            .InitialView = msoFileDialogViewList
            
        End With
        
        
        If fPth.Show = True Then
            fPath = fPth.SelectedItems(1)
            ActiveWorkbook.SaveAs FileName:=fPath & "\" & FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
End Sub