Save Worksheets as Tab Name plus Cell Value and Date

[SuperFerret]

Hello,

I want to be able to save worksheets in my workbook as individual workbooks, using the tab name, a cell value and the date (DD MMM Format)

Basically, I have a workbook which we are using to upload to a new system, and we have devised a workbook where only one worksheet has to be completed and the other worksheets are filled in ready.

The problem is I have to have each of these sheets as individual workbooks to load into the system which is very time consuming.

I can't work out how to split the workbook into the 5 sheets, and rename them (should be saved as TABNAME_cellA2value_DD_MMM.xls)

Any help would be appreciated!

 

[Yahya]

see this link
http://www.mrexcel.com/forum/showthread.php?t=565004

 

[SuperFerret]

Thanks Yahya, but that doesn't really do what I need.

All the Sheets have a different name
e.g. Activate, Update, Profile, Cost, RRP
All the Sheets A2 cells have the same value
e.g. C1

I need to split out each sheet and save it for example like this:
S:\CREATES\Activate_C1_21_JUL.xls

 

[Yahya]

you want to copy the sheet to new workbook

 

[Yahya]

try this

Sub Test()
Dim ws As Worksheet, wb As Workbook
Application.DisplayAlerts = False
For Each ws In Sheets
    Workbooks.Add
    Set wb = ActiveWorkbook
    With wb
        .SaveAs Filename:="S:\CREATES\" & ws.Name & "_" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & ".xls"
        ws.Copy Before:=.Sheets(1)
        .Save
        .Close
    End With
Next ws
Application.DisplayAlerts = True
End Sub

 

[SuperFerret]

Sorry yes all Sheets except one called DATA, is there a way to ignore the sheet called DATA?

The macro does exactly what I need so far thanks for all your help Yahya

 

[Yahya]

try this to ignore sheet DATA

Sub Test()
Dim ws As Worksheet, wb As Workbook
Application.DisplayAlerts = False
For Each ws In Sheets
    If ws.Name <> "DATA" Then
        Workbooks.Add
        Set wb = ActiveWorkbook
        With wb
            .SaveAs Filename:="S:\CREATES\" & ws.Name & "_" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & ".xls"
            ws.Copy Before:=.Sheets(1)
            .Save
            .Close
        End With
    End If
Next ws
Application.DisplayAlerts = True
End Sub

 

[SuperFerret]

Thanks again Yahya!

Ok... slight problem

Now I'm being told that the system will not accept formulas... so is there a way to amend this so it copies the others sheets out as values only?

 

[Yahya]

try this please

Sub Test()
Dim ws As Worksheet, wb As Workbook
Application.DisplayAlerts = False
For Each ws In Sheets
    If ws.Name <> "DATA" Then
        Workbooks.Add
        Set wb = ActiveWorkbook
        With wb
            .SaveAs Filename:="S:\CREATES\" & ws.Name & "_" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & ".xls"
            ws.Copy Before:=.Sheets(1)
            .Sheets(1).Cells.Copy
            .Sheets(1).Cells.PasteSpecial xlValues
            .Save
            .Close
        End With
    End If
Next ws
Application.DisplayAlerts = True
End Sub

 

[SuperFerret]

Thanks again, I'm having a problem though when I open the file to check it. It's giving me an error message:

The file you are trying to open, 'Activate_C1_21_Jul', is in a different format that specified by the file extenstion. Verify that the file is not corrupted and is from a trusted source before opening the file. Do you want to open the file now?

I select Yes and it opens fine and looks ok, but it won't let me upload it to the system either...saying the data is invalid

When I try to save it manually it wants to save as .xlsx??