VBA code does not copy to new workbooks

GARTHMAN

New Member
Joined
Apr 3, 2013
Messages
14
Suggestions please... the following code runs successfully as far as creating daily spreadsheets for the year, but the vba codes or macros fail to copy to the new workbooks. In addition to this macro, there are two others that are not showing up in the new files. Thanks in advance for your insight.

Option Explicit

Sub Create_Multiple_Workbooks()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
'
Dim i As Long
Dim wb As Workbook
Dim fec1 As Date, fec2 As Date
Dim l1 As Workbook, h1 As Worksheet
Dim ruta As String, mes As String, ruta2 As String, arch As String
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Ops-Fleetwatch-GFI Comparison") 'name of template sheet
'
ruta = l1.Path & "\"
fec1 = DateSerial(2021, 7, 1) 'YYYY, M, D'
fec2 = DateSerial(2022,6, 30) 'YYYY, M, D'
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 = "Operations-Fleetwatch-GFI Daily Vehicle Log " & Format(i, "MM-DD-YYYY")

ActiveWorkbook.Sheets.Copy
[b4] = Format(i, "DDDD, mm/dd/yyyy 04:00:00")
[e4] = Format((i + 1), "DDDD, mm/dd/yyyy 03:59:59")
Set wb = ActiveWorkbook
Range("E4").NumberFormat = "dd-mm-yyy"
wb.SaveAs Filename:=ruta2 & arch & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb.Close False
Next
Application.StatusBar = False
MsgBox "End"

End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Instead of using this line:
VBA Code:
ActiveWorkbook.Sheets.Copy
to create a new workbook, and saving that, why not just remove that and save the current file with a "SaveAs" command?
That will save the existing workbook under a new name, which will keep all the VBA code.
 
Upvote 0
Solution
Thanks for a quick reply. Removing the line does allow the macros to carry over to the next workbook. However, it hangs up after the 1st one is created and will not continue through the specified date range as it did with the code included. Not sure why. It makes sense to me looking at it, but something is missing that is preventing the progression. I appreciate any additional insights you can provide.

Option Explicit

Sub Create_Multiple_Workbooks()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
'
Dim i As Long
Dim wb As Workbook
Dim fec1 As Date, fec2 As Date
Dim l1 As Workbook, h1 As Worksheet
Dim ruta As String, mes As String, ruta2 As String, arch As String
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Ops-Fleetwatch-GFI Comparison") 'name of template sheet
'
ruta = l1.Path & "\"
fec1 = DateSerial(2021, 7, 13) 'YYYY, M, D'
fec2 = DateSerial(2021, 7, 31) 'YYYY, M, D'
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 = "Operations-Fleetwatch-GFI Daily Vehicle Log " & Format(i, "MM-DD-YYYY")

ActiveWorkbook.Sheets.Copy 'I removed this line'
[b4] = Format(i, "DDDD, mm/dd/yyyy 04:00:00")
[e4] = Format((i + 1), "DDDD, mm/dd/yyyy 03:59:59")
Set wb = ActiveWorkbook
Range("E4").NumberFormat = "dd-mm-yyy"
wb.SaveAs Filename:=ruta2 & arch & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb.Close False
Next
Application.StatusBar = False
MsgBox "End"

End Sub
 
Upvote 0
You will probably need to move this line out of your For...Next loop, and have it at the end of your code:
VBA Code:
wb.Close False
Another, it will close it after the first one and never do the rest.
 
Upvote 0
You will probably need to move this line out of your For...Next loop, and have it at the end of your code:
VBA Code:
wb.Close False
Another, it will close it after the first one and never do the rest.
Thanks for the advice. I ended up removing that line completely and that leaves the last workbook created open. This allows me to verify that all created sheets look and function the way they should. Works like a charm! Thanks for your assistance. YOU da MAN!
 
Upvote 0
You are welcome.
Glad I was able to help.
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,109
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top