macro to copy range data of a sheet and save as new workbook with file name as cell value

[RK Singh]

I have tried the following code but it saves entire sheet into new workbook.

Sub SaveOutput()

Dim dirPath, Filename As String

dirPath = Application.ActiveWorkbook.Path
Worksheets("Sheet1").Range("A:L50").Copy
Filename = ActiveSheet.Range("A2").Value & "_" & Format(Now, "dd-mm-yy")

With ActiveSheet
ActiveSheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=dirPath & "\" & Filename & ".xls"
Application.ActiveWorkbook.Close False
MsgBox "File Saved Successfully"

End With

End Sub

 

[kanadaaa]

Try this:

Sub CreateNewWorkbookWithValues()
    Dim dirPath, fName As String, newWb As Workbook, thisWb As Workbook
    
    Set thisWb = ThisWorkbook
    dirPath = thisWb.Path
    fName = ActiveSheet.Range("A2").Value & "_" & Format(Now, "dd-mm-yy")
    Set newWb = Workbooks.Add
    newWb.SaveAs Filename:=dirPath & "\" & fName
    thisWb.Sheets("Sheet1").Range("A1:L50").Copy newWb.Sheets("Sheet1").Range("A1")

End Sub

 

[RK Singh]

I have tried the following code but it saves entire sheet into new workbook.

Sub SaveOutput()

Dim dirPath, Filename As String

dirPath = Application.ActiveWorkbook.Path
Worksheets("Sheet1").Range("A:L50").Copy
Filename = ActiveSheet.Range("A2").Value & "_" & Format(Now, "dd-mm-yy")

With ActiveSheet
ActiveSheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=dirPath & "\" & Filename & ".xls"
Application.ActiveWorkbook.Close False
MsgBox "File Saved Successfully"

End With

End Sub

Thanks. It works but the new wb is remain open. How to close it after saving?

 

[kanadaaa]

Here:

Sub CreateNewWorkbookWithValues()
    Dim dirPath, fName As String, newWb As Workbook, thisWb As Workbook
    Set thisWb = ThisWorkbook
    dirPath = thisWb.Path
    fName = ActiveSheet.Range("A2").Value & "_" & Format(Now, "dd-mm-yy")
    Application.ScreenUpdating = False
    Set newWb = Workbooks.Add
    thisWb.Sheets("Sheet1").Range("A1:L50").Copy newWb.Sheets("Sheet1").Range("A1")
    newWb.SaveAs Filename:=dirPath & "\" & fName
    newWb.Close
    Application.ScreenUpdating = True
    MsgBox "Workbook created at:" & vbCrLf & vbCrLf & dirPath & "\" & fName
End Sub

 

[RK Singh]

It's Working Well. Thanks for kind support.