Первый комментарий SJR - это исправление вашего вопроса:
у вас слишком много одинарных кавычек в 'Engagement Form'!$I$8'
Второй комментарий упростит ваш код
.
Чтобы минимизировать орфографические ошибки, я предлагаю эту структуру
Option Explicit
Public Sub CheckRequiredCells1()
Const EM_1 = "I6,I8,B12:I12,B16:I16,I18,I28,I30,I32,I36,I38,I40,I44,I46,I48,"
Const EM_2 = "I56,I58,I60,I66,I68,I70,I72,I74,I78,I80,I82,I88,I96,I98,"
Const EM_3 = "B104:I104,I106,B111:I111,B115:I115,L6:Z120"
Const EM = EM_1 & EM_2 & EM_3 'Required ranges on Sheet "Engagement Form"
Const DP = "B9:B19" 'Required ranges on Sheet "Data Protection Crib Sheet"
Const AA = "B9:B44" 'Required ranges on Sheet "A & A Crib Sheet"
Const GC = "B9:B17" 'Required ranges on Sheet "Governance Crib Sheet"
Dim wsEM As Worksheet, wsDP As Worksheet, wsAA As Worksheet, wsGC As Worksheet
Set wsEM = ThisWorkbook.Worksheets("Engagement Form") 'Reference to the sheet
Set wsDP = ThisWorkbook.Worksheets("Data Protection Crib Sheet")
Set wsAA = ThisWorkbook.Worksheets("A & A Crib Sheet")
Set wsGC = ThisWorkbook.Worksheets("Governance Crib Sheet")
Dim rng As Variant, invalid As Long
For Each rng In Array(wsEM.Range(EM), wsDP.Range(DP), wsAA.Range(AA), wsGC.Range(GC))
'rng.Cells.Count = total cells in required range for the sheet being processed
'Application.WorksheetFunction.CountA(rng) = total cells containing data
invalid = invalid + (rng.Cells.Count - Application.WorksheetFunction.CountA(rng))
Next
If invalid > 0 Then MsgBox "Please fill out all " & invalid & " cells"
End Sub
.
Редактировать
В качестве примера, чтобы добавить новый лист (называемый "Sheet1") с его новым набором диапазонов, добавьте такие строки:
Const S1 = "A1:A2, B3:B5" 'Required ranges on Sheet1
Dim wsS1 As Worksheet
Set wsS1 = ThisWorkbook.Worksheets("Sheet1")
и обновите эту строку в цикле For, включив в нее wsS1.Range(S1):
Array(wsEM.Range(EM), wsDP.Range(DP), wsAA.Range(AA), wsGC.Range(GC), wsS1.Range(S1))
и окончательный код становится:
Const EM_1 = "I6,I8,B12:I12,B16:I16,I18,I28,I30,I32,I36,I38,I40,I44,I46,I48,"
Const EM_2 = "I56,I58,I60,I66,I68,I70,I72,I74,I78,I80,I82,I88,I96,I98,"
Const EM_3 = "B104:I104,I106,B111:I111,B115:I115,L6:Z120"
Const EM = EM_1 & EM_2 & EM_3 'Required ranges on Sheet "Engagement Form"
Const DP = "B9:B19" 'Required ranges on Sheet "Data Protection Crib Sheet"
Const AA = "B9:B44" 'Required ranges on Sheet "A & A Crib Sheet"
Const GC = "B9:B17" 'Required ranges on Sheet "Governance Crib Sheet"
Const S1 = "A1:A2, B3:B5" '<--- New sheet, with new equired ranges (on Sheet1)
Dim wsEM As Worksheet, wsDP As Worksheet, wsAA As Worksheet, wsGC As Worksheet
Dim wsS1 As Worksheet '<--- New sheet
Set wsEM = ThisWorkbook.Worksheets("Engagement Form") 'Reference to the sheet
Set wsDP = ThisWorkbook.Worksheets("Data Protection Crib Sheet")
Set wsAA = ThisWorkbook.Worksheets("A & A Crib Sheet")
Set wsGC = ThisWorkbook.Worksheets("Governance Crib Sheet")
Set wsS1 = ThisWorkbook.Worksheets("Sheet1") '<--- New sheet
Dim rng As Variant, invalid As Long
For Each rng In Array(wsEM.Range(EM), wsDP.Range(DP), wsAA.Range(AA), wsGC.Range(GC), _
wsS1.Range(S1))
invalid = invalid + (rng.Cells.Count - Application.WorksheetFunction.CountA(rng))
Next
If invalid > 0 Then MsgBox "Please fill out all " & invalid & " cells"