Прежде всего уменьшите ваши действия по скрытию и отображению до одного для true и одного для false, чтобы ускорить его. Например
ws.Range("54:54,68:68,82:82,96:96,24:28").EntireRow.Hidden = False
ws.Range("55:63,69:77,83:91,97:105,18:23,29:47").EntireRow.Hidden = True
Обратите внимание, что вы должны использовать Range вместо Rows здесь.
И поместите ваш код в процедуру, чтобы вы могли повторно использовать его для любого листа. Обратите внимание, что вам нужно настроить код для France, Spain и Italy
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False 'Prevents general pop-ups
Application.Calculation = xlManual 'Formulas are not calculated
Application.ScreenUpdating = False 'What the user see's on screen will not change
If Intersect(Target, Me.Range("D10")) Is Nothing Then Exit Sub
' call the function
HideAndUnhideRows ThisWorkbook.Worksheets("Weekly Report - New"), Me.Range("D10").Value
HideAndUnhideRows ThisWorkbook.Worksheets("Cumulative Report - New"), Me.Range("D10").Value
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub HideAndUnhideRows(ws As Worksheet, Criteria As String)
ws.Unprotect
Select Case Criteria
Case "" 'Hides all major city information so just the titles are shown.
ws.Range("54:63,68:77,82:91,96:105,23:47").EntireRow.Hidden = True
ws.Range("18:31").EntireRow.Hidden = False
Case "UK" 'Unhides 'London' under the major cities section and keeps the rest hidden.
ws.Range("54:54,68:68,82:82,96:96,24:28").EntireRow.Hidden = False
ws.Range("55:63,69:77,83:91,97:105,18:23,29:47").EntireRow.Hidden = True
Case "France" 'Unhides 'French Riviera' & 'Paris' under the major cities section and keeps the rest hidden.
Case "Spain" 'Unhides 'Barcelona' & 'Madrid' under the major cities section and keeps the rest hidden.
Case "Italy" 'Unhides 'Florence', 'Maples', 'Milan', 'Rome' & 'Venice' under the major cities section and keeps the rest hidden.
End Select
ws.Range("108:121").EntireRow.Hidden = True
ws.Protect
End Sub