Как запустить макрос в нескольких книгах с критериями фильтра одного листа - PullRequest
0 голосов
/ 05 июля 2019

Я пытаюсь запустить макрос из файла "A: который включает лист с именем" Filter_Criteria "на нескольких листах из определенной папки. На каждом листе" B% "из выбранной папки данные из листа" Данные "должны фильтроваться по диапазонуЛист "Filter_Criteria" из файла A и отправить обратно на лист "Выходной файл" "B%". Проблема в том, что не из файлов из папки фильтруется, и я получил результаты на любом листе "B%".

Макрос проходит от начала до конца без проблем. Внутренний макрос работает нормально при запуске его для каждого файла с:

Set Data_sh = ActiveWorkbook.Sheets("Data")
Set Output_sh = ActiveWorkbook.Sheets("Output")

Но я не могу понять, что не так с текущими изменениями.

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Dim Filter_Criteria_Sh As Worksheet
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
    Set Filter_Criteria_Sh = ThisWorkbook.Sheets("Filter_Criteria")

    'Folder with Worksheets
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If


    'New Excel Process
    Set eApp = New Excel.Application:  eApp.Visible = False


    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName


        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)

'Filter Data Macro

Dim Data_sh As Worksheet
Dim Output_sh As Worksheet


Set Data_sh = wb.Sheets("Data")
Set Output_sh = wb.Sheets("Output")

Output_sh.UsedRange.Clear


Data_sh.AutoFilterMode = False

Dim Emp_list() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria_Sh.Range("A:A")) - 2

ReDim Emp_list(n) As String

Dim i As Integer

For i = 0 To n
    Emp_list(i) = Filter_Criteria_Sh.Range("A" & i + 2)
Next i


Data_sh.UsedRange.AutoFilter 2, Emp_list(), xlFilterValues
Data_sh.UsedRange.Copy Output_sh.Range("A1")

Data_sh.AutoFilterMode = False


MsgBox ("Data has been Copied")

        wb.Close SaveChanges:=False 
        Debug.Print "Processed " & folderName & "\" & fileName
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

Я ожидаю, что «Макрос фильтра данных» будет фильтровать данные в каждом файле с критериями фильтрации, хранящимися в рабочей таблице «А»

1 Ответ

0 голосов
/ 06 июля 2019
wb.Close SaveChanges:=False

Вы не сохраняете изменения, внесенные в рабочие книги.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...