Sub Create_Multiple_Workbooks()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
'
Dim fec1 As Date, fec2 As Date
Dim l1 As Workbook, h1 As Worksheet
Dim ruta As String
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Template") 'name of template sheet
'
ruta = l1.Path & "\"
fec1 = DateSerial(Year(Date), 1, 1)
fec2 = DateSerial(Year(Date), 12, 31)
For i = fec1 To fec2
Application.StatusBar = "Creating file : " & i
mes = Format(i, "mmm")
If Dir(ruta & mes & "\") = "" Then
MkDir (ruta & mes)
End If
ruta2 = ruta & mes & "\"
arch = "cash-out " & Format(i, "mm-dd-yyyy")
h1.Copy
Set l2 = ActiveWorkbook
l2.SaveAs Filename:=ruta2 & arch & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
l2.Close False
Next
Application.StatusBar = False
MsgBox "End"
End Sub