This might be a bit faster, but you won't get away without creating the file
and saving it.
Sub CreateWrkbk()

Const kRoot As String = _
"C:\Documents and Settings\nc1\Application Data\"
Const kTemplate As String = _
"Microsoft\Templates\TAS template.xlt"
Dim x As String, z As String
Dim i As Long

Application.ScreenUpdating = False

StartTime = Timer

i = 1
Do Until IsEmpty(Cells(i, "A").Value)
x = Cells(i, "A").Value
' Workbooks.Add
Set WkBkTmpOpn = Workbooks.Add(template:=kRoot & kTemplate)
With ActiveWorkbook
.Range("K4") = x
.SaveAs Filename:=kRoot & "Desktop\TAS\" _
& x & " Time allocation schedule"
.Close
End With
Loop

EndTime = Timer
z = Format(EndTime - StartTime, "0.0")

MsgBox z

Application.ScreenUpdating = True

End Sub



--

HTH

RP
(remove nothere from the email address if mailing direct)


"nc" wrote in message
...
Hi

I have written a macro below to go through a list, copy each item in the
list, open a template and paste the item on the template, close & save
with
the item as part of the file name. Could you help me ammend the code to
speed it up and if possible to create the file with the item on it but
without opening and saving & closing it.

Thanks in advance.

Sub CreateWrkbk()

Dim x As String, z As String


Application.ScreenUpdating = False

StartTime = Timer

Range("A1").Select
Do Until ActiveCell.Offset(1, 0) = ""
ActiveCell.Offset(1, 0).Select
x = ActiveCell.Value
' Workbooks.Add
Set WkBkTmpOpn = Workbooks.Add(template:="C:\Documents and
Settings\nc1\Application Data\Microsoft\Templates\TAS template.xlt")
Range("K4") = x
ActiveWorkbook.SaveAs Filename:="C:\Documents and
Settings\nc1\Desktop\TAS\" _
& x & " Time allocation schedule"
ActiveWindow.Close
Loop
EndTime = Timer

z = Format(EndTime - StartTime, "0.0")

MsgBox z

Application.ScreenUpdating = True

End Sub