Public Function PRDX_RangeToArray1x(ByVal rng As Range, Optional WithAddress As Boolean) As Variant()
Dim ar As Range, cl As Range, arr, arrVal, arrAdr, arrFull, x, n&, r&, C%
n = rng.Cells.Count: ReDim arrVal(0 To n - 1)
If WithAddress Then ReDim arrAdr(0 To n - 1): ReDim arrFull(0 To 1): n = -1 Else: n = -1: GoTo NoAdr

'========== 2 массива (значения и адреса / медленно)
    For Each ar In rng.Areas
        If ar.Cells.Count = 1 Then
            n = n + 1: arrVal(n) = ar.Cells(1).Value2: arrAdr(n) = ar.Cells(1).Address
        Else
            arr = ar.Value2
            For C = 1 To UBound(arr, 2)
                For r = 1 To UBound(arr, 1)
                    n = n + 1: arrVal(n) = arr(r, C): arrAdr(n) = ar(r, C).Address
                Next r
            Next C
        End If
    Next ar
arrFull(0) = arrVal: arrFull(1) = arrAdr: PRDX_RangeToArray1x = arrFull: Exit Function

'========== 1 массив (только значения / быстро)
NoAdr:
    For Each ar In rng.Areas
        If ar.Cells.Count = 1 Then
            n = n + 1: arrVal(n) = ar.Cells(1).Value2
        Else
            arr = ar.Value2
            For C = 1 To UBound(arr, 2)
                For r = 1 To UBound(arr, 1)
                    n = n + 1: arrVal(n) = arr(r, C)
                Next r
            Next C
        End If
    Next ar
PRDX_RangeToArray1x = arrVal
End Function

Option Explicit
'===============================================================================================================================================================
Sub DelSheets_HARD()
Dim sh As Worksheet, arr(), x, temp, lr&, i&, delim$, strCompare$
delim = "%%%"                                                                               ' прописываем разделитель. Нужен для корректного поиска. Может быть другим, но не должен встречаться в искомом тексте
lr = Worksheets("0").Cells(Rows.Count, 7).End(xlUp).Row                                     ' определяем последнюю заполненную строку 7 столбца на листе "0". Метод "прыжка".
    If lr = 1 Then                                                                          ' если последняя ячейка в 1 строке…
        If Len(Worksheets("0").Cells(1, 7).Value) = 0 Then                                  ' если ячейка пуста (количество символов содержимого = 0)…
            MsgBox "Список разрешённых листов не найден!", vbCritical, "ОШИБКА АЛГОРИТМА"
            Exit Sub
        Else
            strCompare = delim & Worksheets("0").Cells(1, 7).Value & delim                  ' если разрешён только 1 лист, то, чтобы не ломать алгоритм, всё равно создаём строку для сравнения
        End If
    Else
        temp = Worksheets("0").Cells(1, 7).Resize(lr, 1).Value                              ' если дошли до сюда, то разрешённых листов больше одного, а значит забираем весь диапазон в массив
        ReDim arr(0 To UBound(temp, 1))                                                     ' объявляем новый массив
        i = -1
            For Each x In temp
                i = i + 1
                arr(i) = x                                                                  ' наполняем новый массив в цикле
            Next x
        strCompare = delim & Join(arr, delim) & delim                                       ' все эти манипуляции с массивами нужны только для того, чтобы получить строку для сравнения (все имена "разрешённых" листов, сцепленные через разделитель + разделители по краям строки слева и справа)
    End If
    
MsgBox strCompare 'вывод строки, чтобы вы её увидели (удалить эту строку кода после ознакомления)

Application.DisplayAlerts = 0                                                               ' отключаем предупреждения об удалении листа
    For Each sh In ActiveWorkbook.Worksheets                                                ' главный цикл (по листам книги). Сравниваем, содержится ли имя текущего проверяемого листа в цикле в списке разрешённых (строка сравнения). Строка сравнения позволяет избежать двойного цикла.
        If InStr(1, strCompare, delim & sh.Name & delim) = 0 Then
            sh.Delete
        End If
    Next sh
Application.DisplayAlerts = 1                                                               ' включаем предупреждения об удалении листа обратно
End Sub
'===============================================================================================================================================================
Sub DelSheets_EASY()
Dim sh As Worksheet, rng As Range, cl As Range, lr&, flag As Boolean
lr = Worksheets("0").Cells(Rows.Count, 7).End(xlUp).Row
Set rng = Worksheets("0").Cells(1, 7).Resize(lr, 1) 'запоминаем диапазон "разрешённых" листов
Application.DisplayAlerts = 0
    For Each sh In ActiveWorkbook.Worksheets
        For Each cl In rng.Cells
            If CStr(cl.Value) = sh.Name Then flag = True ' если значение ячейки=имени листа, то ставим флаг, что этот лист - разрешённый и его удалять не надо
        Next cl
        If flag = False Then sh.Delete  ' если флаг не выставлен, то удаляем
        flag = False 'скидываем флаг
    Next sh
Application.DisplayAlerts = 1
End Sub
'===============================================================================================================================================================