We help IT Professionals succeed at work.

save file using sheet name and text from a cell in another sheet

Jagwarman
Jagwarman asked
on
I need to save each sheet in my workbook [Except for the sheet named Rec]

The path is  C:\Cpn\CA\Events\Red\2015 [which will change every year] \Mar 15 [which will change each month]

*I would like the macro to create a folder for year and month if there is no folder already there

the file name will be the sheet name and then the name in cell C38 from Sheet named Rec.

so file name would be like: Book3 - AB123456 - Red - 160315 [book3 being sheet name] [ - AB123456 - Red - 160315 being in cell C38 in sheet Rec]

so file path and name would be:  C:\Cpn\CA\Events\Red\2015\Mar 15\Book3 - AB123456 - Red - 160315.xls

Thanks in advance
Comment
Watch Question

Top Expert 2015

Commented:
Basis of rory code which he wrote here for you...

Save Macro

You can tweak this code like this...

Sub SaveMe()
Const csROOT_PATH As String = " C:\Cpn\CA\Events\Red\"

If Dir(csROOT_PATH & Year(Date), vbDirectory) = vbNullString Then
    MkDir csROOT_PATH & Year(Date)
End If
If Dir(csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy"), vbDirectory) = vbNullString Then
    MkDir csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy")
End If
ActiveWorkbook.SaveAs Filename:=csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy") & "\" & Activesheet.name & ActiveSheet.Range("C38").Value & ".xlsx" , FileFormat:=51

End Sub

Open in new window


Saurabh

Author

Commented:
I tried that myself but it does not do what I need.

I need to save each sheet in my workbook [Except for the sheet named Rec]

the other sheets [and there can be many of them] are the ones I need to save with the name of their sheet plus the text that is in cell C38 which is in the sheet named Rec.

Regards
Commented:
this is what I got:
Sub test()

Path = " C:\Cpn\CA\Events\Red\"
C38_Val = ActiveWorkbook.Sheets("Rec").Range("C38").Value
Dim cwb As Workbook
Set cwb = ActiveWorkbook

Path1 = Path + CStr(Year(Now))
Path2 = Path1 + "\" + MonthName(Month(Now), True) + Space(1) + Right(CStr(Year(Now)), 2)


  If Dir(Path2, vbDirectory) = vbNullString Then
        MkDir (Path1)
        MkDir (Path2)
  End If
  
 
For Each ws In cwb.Worksheets 'SetVersions
    If ws.Name <> "Rec" Then
        Dim wb As Workbook
        Set wb = ws.Application.Workbooks.Add
        ws.Copy Before:=wb.Sheets(1)
        wb.SaveAs Path2 & "\" & ws.Name & C38_Val, Excel.XlFileFormat.xlOpenXMLWorkbook
        wb.Close
        Set wb = Nothing
    End If
Next ws


End Sub

Open in new window

Since you didn't tell me where to get the year or month from, it's the year and month from the time you run the macro.
Top Expert 2015
Commented:
Use this version of code a little bit modified...

Sub SaveMe()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim ws As Worksheet

    Set wb = ActiveWorkbook
    Const csROOT_PATH As String = " C:\Cpn\CA\Events\Red\"

    If Dir(csROOT_PATH & Year(Date), vbDirectory) = vbNullString Then
        MkDir csROOT_PATH & Year(Date)
    End If
    If Dir(csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy"), vbDirectory) = vbNullString Then
        MkDir csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy")
    End If


    For Each ws In ActiveWorkbook.Worksheets
        If InStr(1, ws.Name, "rec", vbTextCompare) = 0 Then
            ws.Copy
            Set wb1 = ActiveWorkbook
            wb1.SaveAs Filename:=csROOT_PATH & Year(Date) & "\" & Format(Date, "mmm yy") & "\" & ActiveSheet.Name & ActiveSheet.Range("C38").Value & ".xlsx", FileFormat:=51
            wb1.Close (True)
            wb.Activate
        End If

    Next ws

End Sub

Open in new window

Author

Commented:
Kimputer thanks yours did exactly what I needed

Author

Commented:
Saurabh Singh Teotia thank you for your I will definitely be able to use in the future but Kimputers was what I needed.