Цикл автофильтра с использованием массива - PullRequest
Новая
       26

Цикл автофильтра с использованием массива

0 голосов
/ 28 августа 2018

У меня проблемы с отладкой кода. У меня есть массив с критерием столбца автофильтра. Мой код должен проходить по массиву, открывать набор файлов и копировать и вставлять информацию в мою книгу.

Когда я запускаю код, он не автоматически заполняется до нужного критерия и показывает ошибку времени выполнения 1004. Я уже пытался искать решения или похожие проблемы, но ничего не нашел. Я также попытался записать макрос, чтобы изменить подход, но при попытке реализовать цикл он не работает: (

Любая помощь оценивается! 

Sub Update_Database()

Dim directory As String
Dim fileName As String
Dim my_array() As String
Dim iLoop As Integer

ReDim my_array(18)
my_array(0) = "Aneng"
my_array(1) = "Bayswater"
my_array(2) = "Bad Blankenburg"
my_array(3) = "Halstead"
my_array(4) = "Jorf Lasfar"
my_array(5) = "Kolkatta"
my_array(6) = "Marysville"
my_array(7) = "Northeim"
my_array(8) = "Ponta Grossa"
my_array(9) = "Puchov"
my_array(10) = "Renca"
my_array(11) = "Padre Hurtado"
my_array(12) = "Shanxi"
my_array(13) = "San Luis Potosi"
my_array(14) = "Szeged"
my_array(15) = "Tampere"
my_array(16) = "Uitenhage"
my_array(17) = "Veliki Crljeni"

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    directory = .SelectedItems(1)
    Err.Clear
End With

fileName = Dir(directory & "\", vbReadOnly)

Dim mwb As Workbook
Set mwb = Workbooks("OEE_Database_Final.xlsm")

Do While fileName <> ""
    For iLoop = LBound(my_array) To UBound(my_array)
        On erro GoTo ProcExit
        With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
            Selection.AutoFilter Field:=1, Criterial:=my_array(iLoop)
            mwb.Worksheets(8).Range("O9:Z2945") = .Worksheets(8).Range("O9:Z2945").Value2
            .Close SaveChanges:=False
        End With
        fileName = Dir
    Next iLoop
Loop

ActiveSheet.ShowAllData

ProcExit:
Exit Sub

End Sub
...