Saving worksheets as filenames

[AmyTaylor]

Hi everyone, this sort of relates to an earlier message, but I have tried to simplfy what I am asking about (more for my benefit than yours!)

I have a spreadsheet with a number of worksheets, eg: Name1, Name2, Name3.

These names are held in worksheet "AllNames" between cells A1:A10

What I would like to do is loop thru the list of names in "AllNames" A1:A10 and for each inidividual worksheet save the relevant worksheet as a new workbook file in the same filepath but a folder called "Names". If possible with the date it was saved hard coded in.

Is this possible??
If so, all help gratefully received

Love Amy xx

[Bob Phillips]

For Each cell In Range("AllNames")
worksheets(cell.Value).Copy
Activeworkbook.SaveAs "Names\" & _
Format(Date,"yyy-mm-dd hh:mm:ss") & ".xls"
Next cell

AmyTaylor wrote:
> Hi everyone, this sort of relates to an earlier message, but I have
> tried to simplfy what I am asking about (more for my benefit than
> yours!)
>
> I have a spreadsheet with a number of worksheets, eg: Name1, Name2,
> Name3.
>
> These names are held in worksheet "AllNames" between cells A1:A10
>
> What I would like to do is loop thru the list of names in "AllNames"
> A1:A10 and for each inidividual worksheet save the relevant worksheet
> as a new workbook file in the same filepath but a folder called
> "Names". If possible with the date it was saved hard coded in.
>
> Is this possible??
> If so, all help gratefully received
>
> Love Amy xx
>
>

[Die_Another_Day]

Sub SaveSheetNames()
Dim i As Integer
Dim File1 As Workbook
Dim Path1 As String
Set File1 = ActiveWorkbook
Sheets("AllNames").Activate
Path1 = File1.Path & "\Names"
If Not FSO.FolderExists(Path1) Then FSO.CreateFolder (Path1)
For i = 1 To 10
Sheets(Cells(i, 1).Value).Copy
ActiveWorkbook.SaveAs Filename:=Path1 & "\" & Cells(i, 1).Value &
Replace(Date, "/", "-") _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close False
File1.Activate
Sheets("AllNames").Activate
Next
End Sub

There's my 2 minute attempt at it. Note there is NO error checking so
make sure that the AllNames sheet range A1:A10 all contain valid sheet
names

Die_Another_Day