Save a range to a new workbook and save as a specific title?

[DMO123]

HI All,

bit of a strange one, i have been researching and cannot find anything relating to this. but i want to save a range in a workbook to a new workbook in a specific location under a new name.

so i have workbook 1 with 4 sheets i want to save sheet 1 range A2:R10000 as a new workbook as "TODAYSDATE"_created. to say "Z:"

is this possible? if so can someone help me with a VBA button?

thank you!

 

[Yongle]

adapt this to your needs
- 2 suggestions for file name included (use only one or something else!)
- you did not say whether values or formulas to be copied (delete PasteValues to retain formulas)

Sub SaveRangeToNewBook()
Dim Rng         As Range:       Set Rng = ThisWorkbook.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("[COLOR=#ff0000]A2:R10000[/COLOR]")
Dim Wb          As Workbook:    Set Wb = Workbooks.Add
Dim fpath       As String:      fpath = "[COLOR=#ff0000]K:\folder\Subfolder[/COLOR]"
Dim fname       As String:      fname = "ConsistentName" & Format(Date, "_YYMMDD")
                                fname = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Format(Date, "_YYMMDD")
Rng.Copy
With Wb.Sheets(1).Range("A1")
    .PasteSpecial (xlPasteAll)
    .PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteColumnWidths)
End With

'save the workbook
Wb.SaveAs Filename:=fpath & Chr(92) & fname, FileFormat:=51
'and close
Wb.Close (False)
End Sub

 

[DMO123]

Thank you so much! works a dream!

i was able to update the line

[COLOR=#333333]fname = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Format(Date, "_YYMMDD")[/COLOR]

to

fname = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Format(Date, "_DDMMYYYY") & ("_Created")

which capture the desired file name in case you needed this too.

thank you!

 

[Yongle]

thanks for your feedback