Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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 |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
oh, and add
i=i+1 before the Loop statement -- HTH RP (remove nothere from the email address if mailing direct) "Bob Phillips" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Playing a macro from another workbook | Excel Discussion (Misc queries) | |||
automatic macro update | Excel Worksheet Functions | |||
Date macro | Excel Discussion (Misc queries) | |||
Macro and If Statement | Excel Discussion (Misc queries) | |||
Macro Formula revision? | Excel Worksheet Functions |