Изменение размеров массива на другой диапазон ячеек, не принимающих никакого значения

Question

У меня есть список имен в 4 разных столбцах, и я хочу отфильтровать данные, связанные с каждым именем. Но поскольку имена находятся в разных полях таблицы, мне нужно изменить критерий «Поле», поэтому пришлось четыре раза запускать код для фильтрации. Для этого я пытался изменить размер своего массива после каждого запуска, но он выдает ошибку после первого успешного запуска.

Когда я проверил в непосредственном окне, я обнаружил, что это не получение любого значения в массиве, когда я переделываю его во второй раз. Я попытался использовать Erase, чтобы убедиться, что в массиве нет предыдущих значений, но он не работает. Я что-то упустил?

Я получаю сообщение об ошибке, когда код пытается присвоить имя только что созданному листу, но, поскольку он пуст, он выдает ошибку «имя не найдено»

Любая помощь будет принята с благодарностью.

Спасибо

Вот код, который у меня есть.

ReDim arr(1 To lRow - 1)

For i = 1 To lRow - 1

    arr(i) = Cells(i + 1, 33).Value

Next i

For j = 1 To lRow - 1

If fws.AutoFilterMode Then fws.AutoFilterMode = False

fws.Range("A1").CurrentRegion.AutoFilter Field:=21, Criteria1:=arr(j)

    Set FRange = fws.AutoFilter.Range
    Set nws = Worksheets.Add

    With nws
        .Name = arr(j)
    End With

    FRange.Copy
    nws.Activate
    ActiveSheet.Range("A1").PasteSpecial xlPasteValues

    lRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).row
    ActiveSheet.Range("A1:A" & lRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Next j

fws.AutoFilterMode = False
lRow = fws.Range("AH" & fws.Rows.Count).End(xlUp).row
i = 0

ReDim arr(1 To lRow - 1)

For i = 1 To lRow - 1

    arr(i) = Cells(i + 1, 34).Value

Next i

j = 0

For j = 1 To lRow - 1

If fws.AutoFilterMode Then fws.AutoFilterMode = False

fws.Range("A1").CurrentRegion.AutoFilter Field:=15, Criteria1:=arr(j)

    Set FRange = fws.AutoFilter.Range
    Set nws = Worksheets.Add 

    With nws
        .Name = arr(j) `**I am getting error here**'
    End With

    FRange.Copy
    nws.Activate
    ActiveSheet.Range("A1").PasteSpecial xlPasteValues

    lRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).row
    ActiveSheet.Range("A1:A" & lRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Next j

Answer 1

arr(i) = Cells(i + 1, 34).Value 

какой рабочий лист активен при его запуске? По умолчанию это будет брать значения из ActiveSheet. Вам необходимо явно связать каждую ссылку Cells / Range с объектом рабочего листа, иначе ваш код не будет надежным.