Macro help

[nc]

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

 

[Bob Phillips]

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)

 

[JE McGimpsey]

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.

 

[Bob Phillips]

oh, and add
i=i+1
before the Loop statement

--

HTH

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