Copying Several Sheets To a New Uniquely Named Workbook

[soteman2005]

Hi,

I am trying to create a script that will create a new uniquely named
workbook with time and date, and copy several of the worksheets from my
original workbook into the new workbook. I have got the code below
which works for the activesheet but how would I get it to do it for
several specified sheets? I will use this script in several models and
so I can't specify the workbook name and keep switching between
workbooks to copy them.

Any help would be great!

Thanks


Code:
--------------------
Sub Create_Factbase()

Dim FileName As String
Application.ScreenUpdating = False
FileName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
ActiveSheet.Cells.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
ActiveWorkbook.SaveAs FileName:=FileName + "_" + Format(Date, "dd-mm-yy") + _
"_" + Format(Time, "hh-mm-ss")
ActiveSheet.Range("a1").Select
Application.ScreenUpdating = True


End Sub

 

[Tom Ogilvy]

Sub Create_Factbase1()
Dim sh as Worksheet
Dim FileName as String
FileName = "something"
worksheest(Array("Data","Sales","Earnings")).copy
for each sh in activeWorkbook
sh.cells.copy
sh.cells.pastespecial paste:=xlValues
Next
ActiveWorkbook.SaveAs FileName:=FileName + "_" + Format(Date, "dd-mm-yy")
+ _
"_" + Format(Time, "hh-mm-ss")

ActiveSheet.Range("a1").Select
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy


"soteman2005" <[email protected]>
wrote in message