create new workbooks using an existing Excel template

[panama407]

Hello,

Is there any way to use a VBA macro to create new workbooks using an existing Excel template and have the new workbooks saved with each of the business days of the month/s?

such as SSB Template Update.xls being saved as SSB 09.03.18.xls.


Thank you,

Peter

 

[panama407]

This is as far as I have gotten:

Sub Macro1()
'
' Macro1 Macro
'

'
ChDir "O:\ACCTG\Team E\Tasks\Wrapper Notifications\SSB\2018\10 October"
ActiveWorkbook.SaveAs Filename:= _
"O:\ACCTG\Team E\Tasks\Wrapper Notifications\SSB\2018\10 October\SSB 10.01.18.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

 

[Logit]

.

Option Explicit


Sub SaveSheet()
  Dim strPath  As String


  Application.ScreenUpdating = False
  Application.EnableEvents = False


  With Worksheets("SSB")
    strPath = CreateObject("Wscript.Shell").SpecialFolders(4) & Application.PathSeparator & _
    ActiveSheet.Name & " " & .Range("B1").Value & ".xls"
    .Copy
  End With
  
  ActiveWorkbook.SaveAs strPath, xlOpenXMLWorkbook


  ActiveWorkbook.Close False
  Application.EnableEvents = True
End Sub

[][Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][th]

D​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

1​

[/td][td]Enter Date Here --->[/td][td]09.03.18[/td][td][/td][td][/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

2​

[/td][td][/td][td]CommandButton Here[/td][td][/td][td][/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

3​

[/td][td][/td][td][/td][td][/td][td][/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

4​

[/td][td][/td][td]This is your template sheet[/td][td][/td][td][/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

5​

[/td][td][/td][td]named SSB[/td][td][/td][td][/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

6​

[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]

 

[panama407]

Thank you for replying but the Excel template that I want copied has column headings and other static information in some cells and it is on Sheet1. I was looking to have the whole Excel "Workbook" template copied and saved out on the network drive under the new name with "each" of the business days of the month. I have 7 Excel template workbooks that I copy and created for each business day of the month. For example I had to make 20 copies of each template for September 2018. SSB 09.03.18.xls, SSB 09.04.18.xls, SSB 09.035.18.xls, etc.

 

[Logit]

.
Here is one way :

Option Explicit




Sub Macro1()
'
' Macro1 Macro
'


'
Dim i As Integer
Dim j As Integer


j = 1
For i = 1 To 31
    For j = 1 To 31
        ChDir "C:\Users\My\Desktop\"
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\My\Desktop\test\SSB 10." & j & ".18.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Next j
    If j = 32 Then Exit Sub
Next i
End Sub

You will need to edit the paths for your system.

 

[panama407]

.
Here is one way :

Option Explicit




Sub Macro1()
'
' Macro1 Macro
'


'
Dim i As Integer
Dim j As Integer


j = 1
For i = 1 To 31
    For j = 1 To 31
        ChDir "C:\Users\My\Desktop\"
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\My\Desktop\test\SSB 10." & j & ".18.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Next j
    If j = 32 Then Exit Sub
Next i
End Sub

You will need to edit the paths for your system.

Thank you so much

 

[Logit]

.
You are welcome.

 

[panama407]

.
You are welcome.

Woud it be too hard to use the Workday to filter out weekend days?

 

[Logit]

.
Excludes weekends :

Sub WBforMonth2()
   Dim Dte As Date
   Dim i As Long
   
   Dte = InputBox("Please enter a date")
   ChDir "C:\Users\My\Desktop\"
   For i = 1 To Application.NetworkDays(Dte, (Application.EoMonth(Dte, 0)))
      ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\My\Desktop\test\SSB " & Format(Application.WorkDay(Dte, i), "mm-dd-yyyy") & ".xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
   Next i


End Sub