how to saveas Excel worksheet with preferred name by saveas dialog box by vba

[m_vishal_c]

HI
I have saveral worksheets in a workbook. how to saveas excel worksheet to particular location by saveas dialog box
I found below code and i just modified but it saves entire workbook, i just want to save particular worksheet as new workbook
Dim workbook_name As Variant
Dim s As Worksheet
Set s = Sheets("Main")
workbook_name = Application.GetSaveAsFilename(InitialFileName:=s.Cells(12, 18))

If workbook_name <> False Then
ActiveSheet.SaveAs Filename:=workbook_name
End If

heaps thanks in advance

 

[afonsomira]

Hello,

Try this code:

Sub sb_Copy_Save_ActiveSheet_As_Workbook()
        Set wb = Workbooks.Add
    ThisWorkbook.Activate
    ActiveSheet.Copy Before:=wb.Sheets(1)
    wb.Activate
    'Change the path here
    wb.SaveAs "C:\temp\test3.xlsx"
End Sub

 

[m_vishal_c]

HI Thanks for your reply. I wanted to get it done by save as dialog box . but its okay i get sorted by below code

Dim fname As String
Dim fpath As String
Dim NewBook As Workbook
Dim name As String
Dim diaFolder As FileDialog
Dim selected As Boolean

' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
selected = diaFolder.Show

If selected Then
MsgBox diaFolder.SelectedItems(1)
End If


fpath = diaFolder.SelectedItems(1)
fname = sh.Cells(13, 18) & ".xlsx"
name = Range("c3").Value
Dim fn As String
fn = sh.Cells(13, 18)
Set NewBook = Workbooks.Add

On Error Resume Next
Set ws = ThisWorkbook.Sheets(fn)
On Error GoTo 0

If ws Is Nothing Then
MsgBox "sheet doesn't exist"
Exit Sub
End If

If Dir(fpath & "\" & fname) = vbNullString Then
ThisWorkbook.Sheets(fn).Copy
ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
ActiveWorkbook.Close
Sheets("Main").Activate
Else
MsgBox "File " & fpath & "\" & fname & " already exists"
NewBook.Close
Sheets("Main").Activate
Exit Sub
End If