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

RK Singh

New Member
Joined
May 22, 2020
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
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
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Try this:
VBA Code:
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

New Member
Joined
May 22, 2020
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
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

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Here:
VBA Code:
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

New Member
Joined
May 22, 2020
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
It's Working Well. Thanks for kind support.
 

Forum statistics

Threads
1,144,673
Messages
5,725,701
Members
422,636
Latest member
GatorsBucs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top