Change Font when using xWs.Copy macro

[mazman65]

I am using the following VBA to split a workbook and create new workbooks. The Master workbook is in Calibri 11 font, and when the new workbooks are created they are with Aptos due to the new Office 365 Templates.

The new workbooks are not macro-enabled workbooks and I dont want to open each new workbook(21) to change the font.

Is there a way to split this workbook, created the new workbooks and "save as" with the updated font to Calibri?

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & "1234567890" & Format(VBA.Now, "YYYYMMDD") & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Jeffrey Mahoney]