This may be marginally faster:

Public Sub CreateWrkbk()
Const sTEMPLATE = "C:\Documents and Settings\nc1\" & _
"Application Data\Microsoft\Templates\TAS template.xlt"
Const sFILENAME = "C:\Documents and Settings\nc1\" & _
"Desktop\TAS\$$ Time allocation schedule"
Dim vTemp As Variant
Dim i As Long
Application.ScreenUpdating = False
vTemp = Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row).Value
For i = LBound(vTemp, 1) To UBound(vTemp, 1)
With Workbooks.Add(template:=sTEMPLATE)
.Sheets(1).Range("K4").Value = vTemp(i, 1)
.SaveAs Filename:=Application.Substitute( _
sFILENAME, "$$", vTemp(i, 1))
.Close SaveChanges:=False
End With
Next i
End Sub

However, you'll still need to create, save and close the workbooks.

In article ,
"nc" wrote:

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