Macro help

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

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" <[email protected]> wrote in message
news:[email protected]...
> 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

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 <[email protected]>,
"nc" <[email protected]> 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

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

--

HTH

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


"Bob Phillips" <[email protected]> wrote in message
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
> > 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
>
>