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


--
AmyTaylor
------------------------------------------------------------------------
AmyTaylor's Profile: http://www.excelforum.com/member.php...o&userid=20970
View this thread: http://www.excelforum.com/showthread...hreadid=536051

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

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