В следующем коде School рассматривается как имя переменной, а не как значение:
If macroNameMon = School Then
Application.Run "CreateSchool"
Попробуйте изменить его на
If macroNameMon = "School" Then
CreateSchool '<-- this will call Sub CreateSchool() no need for Application.Run
Обратите внимание, что вы можете использовать Select Case, что проще, чем кратное If … Then … ElseIf …:
Select Case macroNameMon
Case "School": CreateSchool
Case "Holiday": CreateHoliday
Case "BankHoliday": CreateBH
Case "Boxing": CreateBoxing
End Select
Также обратите внимание, что вы перепутали имена переменных. Вы объявляете Dim macroNameMon As String, но затем используете macroName = Range("C6").Value.
Я рекомендую активировать Option Explicit: в редакторе VBA перейдите на Инструменты › Параметры › Требуется объявление переменных , чтобы избежать неправильные имена переменных.
Также избавьтесь от всех этих .Select утверждений: Как избежать использования Select в Excel VBA .
вместо
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet4").Select
Sheets("Sheet4").name = "Wednesday"
лучше использовать что-то вроде
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Wednesday"
Итак, вы бы получили что-то вроде этого:
Option Explicit
Sub CreateVAS()
Dim NewWb As Workbook
'Step 1 - Create VAS Workbook
Set NewWb = Workbooks.Add 'remember the new workbook in a variable so we can easily access it
NewWb.SaveAs Filename:="C:\Users\Tom\Desktop\VAS.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
'remove all sheets some Excels don't add 3 sheets but only 1. Therefore delete all to not run into odd issues.
Dim i As Long
Application.DisplayAlerts = False
For i = NewWb.Sheets.Count To 2 Step -1
NewWb.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Step 2 - Create Sunday
NewWb.Worksheets(1).Name = "Sunday" 'name first sheet
CreateSunday
'Step 3 - Create Monday
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Monday"
Dim macroNameMon As String
macroNameMon = ThisWokrbook.Worksheet("YourSheet").Range("C6").Value 'specify your workbook and sheet
Select Case macroNameMon
Case "School": CreateSchool
Case "Holiday": CreateHoliday
Case "BankHoliday": CreateBH
Case "Boxing": CreateBoxing
End Select
'the following syntax is wrong
'NewWb.Worksheets("Monday").Paste Destination:=Range("A1")
'it should be something like
ThisWorkbook.Worksheets("yoursource").Range("A1").Copy Destination:=NewWb.Worksheets("Monday").Range("A1")
'Step 4 - Create Tuesday
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Tuesday"
Dim macroNameTue As String
macroNameTue = ThisWokrbook.Worksheet("YourSheet").Range("C8").Value 'specify your workbook and sheet
Select Case macroNameMon
Case "School": CreateSchool
Case "Holiday": CreateHoliday
Case "BankHoliday": CreateBH
Case "Boxing": CreateBoxing
End Select
ThisWorkbook.Worksheets("yoursource").Range("A1").Copy Destination:=NewWb.Worksheets("Tuesday").Range("A1")
'Step 5 - Create Wednesday till Saturday
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Wednesday"
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Thursday"
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Friday"
NewWb.Worksheets.Add(After:=NewWb.Sheets(NewWb.Sheets.Count)).Name = "Saturday"
CreateSaturday
'Step 10 - Save all changes
NewWb.Save
MsgBox "VAS Sheet created. Please rename and place in correct folder."
NewWb.Close
End Sub
Если ваши Create… процедуры не делают ничего, кроме копирования, я предлагаю использовать что-то вроде следующего:
Dim macroNameMon As String
macroNameMon = ThisWokrbook.Worksheet("YourSheet").Range("C6").Value 'specify your workbook and sheet
Dim SourceRange As Range
Select Case macroNameMon
Case "School": Set SourceRange = Thisworkbook.Worksheets("School").Range("A1:N52")
'… and so on
End Select
SourceRange.Copy Destination:=NewWb.Worksheets("Monday").Range("A1")