Правильное использование Application.Run

Question

Я не уверен, что полностью понимаю использование Application.Run. Я попытался использовать это в одном из моих макросов, но я не видел ожидаемого изменения. Вот настройка. У меня есть надстройка Excel, которая запускает несколько макросов из системы меню. Один из макросов будет копировать данные из книги с экстрактом в основную книгу. На днях один из пользователей применил фильтр к одному из столбцов и не очистил его перед запуском кода копирования. Это заставило данные не копировать правильно. Поэтому я исследовал, как запустить код из основной книги из учебника по извлечению, чтобы очистить фильтр до того, как произойдет копирование/вставка.

Чтобы лучше прояснить, как мне это нужно для работы:

1. Рабочего содержит данные, которые должны перейти к Workbook B
2. Рабочий будет сортировать данные и удалять данные, не требуется в рабочая тетрадь B.
3. Workbook B У меня есть код, который будет отображать все данные, если фильтр применяется при открытии и закрытии книги.
4. Перед копированием и вставки данных из книги к Учебное пособие В, я нужно иметь Рабочему вызвать unfilter кода в рабочей книги B для выполнения суб в рабочей книги B.

Это код из экстракта книги (Рабочих) (который использует Add-In):

Sub Extract_Sort_1601_January() 

Dim ANS As Long 

ANS = MsgBox("Is the January 2016 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
If ANS = vbNo Or IsWBOpen("Swivel - Master - January 2016") = False Then 
    MsgBox "The required workbook is not currently open. This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
    Exit Sub 
End If 

Application.ScreenUpdating = False 

    ' This line autofits the columns C, D, O, and P 
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit 

    ' This unhides any hidden rows 
    Cells.EntireRow.Hidden = False 

Dim LR As Long 

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 
     If Range("B" & LR).Value <> "1" Then 
      Rows(LR).EntireRow.Delete 
     End If 
    Next LR 

Application.Run "'Swivel - Master - January 2016.xlsm'!Unfilter" 

With ActiveWorkbook.Worksheets("Extract").Sort 
    With .SortFields 
     .Clear 
     .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    End With 
    .SetRange Range("A2:AE2000") 
    .Apply 
End With 
Cells.WrapText = False 
Sheets("Extract").Range("A2").Select 

    Dim LastRow As Integer, i As Integer, erow As Integer 

    'With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel") 
     'erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
     '.Range("A2:AE" & erow).AutoFilter 'leaving arguments blank clears all filters, but leaves the drop-down arrows (filter mode still on) 
    'End With 

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To LastRow 
     If Cells(i, 2) = "1" Then 

      ' As opposed to selecting the cells, this will copy them directly 
      Range(Cells(i, 1), Cells(i, 31)).Copy 

      ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly 
      With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel") 
       erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
       .Cells(erow, 1).PasteSpecial xlPasteAll 
      End With 
      Application.CutCopyMode = False 
     End If 
    Next i 

Application.ScreenUpdating = True 
End Sub 

Вот код Unfilter, что мне нужно работать на мастер-книге (Workbook B) (это находится в модуле в главной книге):

Sub Unfilter() 

    Dim she As Variant 
    For Each she In Worksheets 
     If she.FilterMode Then she.ShowAllData 
    Next 
End Sub 

Могу ли я с помощью Application.Run правильно? Или есть еще одна проблема с моим кодом? У меня нет ошибок. Когда я протестировал это, данные в книга B осталась отфильтрованной.

Answer 1

Измените подзаголовок Unfilter, чтобы работать непосредственно с книгой, где находится код.

Смотрите ниже:

Sub Unfilter() 

    Dim she As Variant 
    For Each she In ThisWorkbook.Worksheets 
     If she.FilterMode Then she.ShowAllData 
    Next 
End Sub