Add extension to current macro (save each tab as individual file)

[csch123]

Hello,

My current macro saves each sheet as its own file and throws it into a specified folder. The name of each sheet is what the file is saved as. My queston is whether there is a way to essentially keep the macro the same, except for one minor addition. I'd like to have the macro save each sheet as the name tab name, plus add an _ and the value in cell C2 of each sheet to the file name.

For example, the current macro would save a sheet called "February" as February. If the value in cell C2 was "Same Store", I'd like it to save the file as February_Same Store. Does that make sense? Here is my current code:

Sub CreateWorkbooks()
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
strSavePath = "H:\Finance\2013\Ops\Red Clinic Dossier\File Dump Same Store\"
Set wbSource = ActiveWorkbook
For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name
wbDest.Close
Next
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub

Any help would be greatly appreciated!

 

[L33]

Change the 8th line up from the end to read as:

wbDest.SaveAs strSavePath & sht.name & "_" & Range("C2").Value

That should do it.

 

[Trevor G]

Adjust this line, I am showing the .xlsx at the end it might need to be .xls depending on the version of Excel you are using

from

wbDest.SaveAs strSavePath & sht.Name

to

wbDest.SaveAs strSavePath & sht.Name & "_" & sht.Range("c2").Value & ".xlsx"

 

[csch123]

Thank you both! The macro runs great now! Is there a line of code that could be added that saves each document as paste value? Right now it looks to save each individual sheet with links still intact. That makes each file extremely large.