выполняют фильтрацию макроса на листе excel в рабочей книге, с другого листа в другой книге

Question

У меня есть 2 книги работы, Book_1 и Book_2.

Я написал макрос для выполнения фильтрующих функций.

Sub filter_5PKT_rows() 

    Dim My_Range As Range 
    Dim CalcMode As Long 
    Dim ViewMode As Long 


    'Set filter range on ActiveSheet: A1 is the top left cell of the filter range 
    'and the header of the first column, L is the last column in the filter range. 
    'can also add the sheet name to the code like this 

Set My_Range = Range("A1:L" & LastRow(ActiveSheet)) 

' select my range 

My_Range.Parent.Select 

If ActiveWorkbook.ProtectStructure = True Or _ 
     My_Range.Parent.ProtectContents = True Then 
     MsgBox "Sorry, not working when the workbook or worksheet is protected", _ 
       vbOKOnly, "Copy to new worksheet" 
     Exit Sub 
    End If 

    'Change ScreenUpdating, Calculation, EnableEvents, .... 
    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 
    ViewMode = ActiveWindow.View 
    ActiveWindow.View = xlNormalView 
    ActiveSheet.DisplayPageBreaks = False 

'Firstly, remove the AutoFilter 
    My_Range.Parent.AutoFilterMode = False 

    ' My_Range.AutoFilter Field:=4, Criteria1:="=5PKT Men's" 

    My_Range.AutoFilter Field:=4, Criteria1:=Array("5PKT Men's", "5PKT Women's", "5PKT Short"), Operator:=xlFilterValues 

    ' subline and cs(commercial sample) line have no connection to pocket setter 
    ' therefore need to filter out these lines 

    My_Range.AutoFilter Field:=1, Criteria1:=Array("Band 01", "Band 02", "Band 03", "Band 04", "Band 05", "Band 06", "Band 07", "Band 08", "Band 09", "Band 10", "Band 11", "Band 12", "Band 13", "Band 14", "Band 15", "Band 16", "Band 17", "Band 18", "Band 19", "Band 20"), Operator:=xlFilterValues 

' DO NOT SORT ACCORDING TO ORDER QUANTITY. 
' THIS IS BECAUSE THERE ARE INSTANCES, 
' WHERE THE SAME STYLE NUMBER IS BROKEN INTO SEVERAL POS EACH HAVING VARYING ORDER QUANTITIES 

'Restore ScreenUpdating, Calculation, EnableEvents, .... 
    My_Range.Parent.Select 
    ActiveWindow.View = ViewMode 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = CalcMode 
    End With 

End Sub 

Function LastRow(sh As Worksheet) 
    On Error Resume Next 
    LastRow = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlValues, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row 
    On Error GoTo 0 
End Function 

........................................... .....................................

Этот код работает и выполняет фильтрацию согласно мое желание.

Скажем у меня есть строки в Book_1, worksheet_1, с помощью редактора VBA,

я вставить модуль для проекта VBA Book_1 и тип кодирования,

и запустить макрос,

то происходит фильтрация.

.............................................. ..............................

Но: этот код не позволит мне выполнять фильтрацию в Book_1 worksheet_1,

если я место и выполняю макрос из Book_2 workheet_1.

Я хочу выполнить фильтр-макрос в листе Book_A1, с листа Book_2.

Как это можно сделать? Как изменить свою кодировку?

Answer 1

Попробуйте это:

Sub filter_5PKT1_rows() 




    Dim file_name As String 
    Dim sheet_name As String 

    file_name = "C:\Users\Desktop\pocket setter excel\production_plan.xlsm" 'Change to whatever file i want 
    sheet_name = "production_plan" 'Change to whatever sheet i want 


' we set wb as a new work book sonce we have to open it 

Dim wb As New Workbook 

' To open and activate workbook, in this case production_plan 
' it opens and activates the workbook production_plan and activates the worksheet production plan 
' note: the work book has the name production_plan.xlsm and worksheet has the name production_plan 

Set wb = Application.Workbooks.Open(file_name) 

wb.Sheets(sheet_name).Activate 

    Dim My_Range As Range 
    Dim CalcMode As Long 
    Dim ViewMode As Long 


    'Set filter range on ActiveSheet: A1 is the top left cell of the filter range 
    'and the header of the first column, L is the last column in the filter range. 
    'can also add the sheet name to the code like this 

Set My_Range = Range("A1:L" & LastRow(wb.ActiveSheet)) 

' select my range 

My_Range.Parent.Select 

If ActiveWorkbook.ProtectStructure = True Or _ 
     My_Range.Parent.ProtectContents = True Then 
     MsgBox "Sorry, not working when the workbook or worksheet is protected", _ 
       vbOKOnly, "Copy to new worksheet" 
     Exit Sub 
    End If 

    'Change ScreenUpdating, Calculation, EnableEvents, .... 
    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 
    ViewMode = ActiveWindow.View 
    ActiveWindow.View = xlNormalView 
    wb.ActiveSheet.DisplayPageBreaks = False 

'Firstly, remove the AutoFilter 
    My_Range.Parent.AutoFilterMode = False 

    ' My_Range.AutoFilter Field:=4, Criteria1:="=5PKT Men's" 

    My_Range.AutoFilter Field:=4, Criteria1:=Array("5PKT Men's", "5PKT Women's", "5PKT Short"), Operator:=xlFilterValues 

    ' subline and cs(commercial sample) line have no connection to pocket setter 
    ' therefore need to filter out these lines 

    My_Range.AutoFilter Field:=1, Criteria1:=Array("Band 01", "Band 02", "Band 03", "Band 04", "Band 05", "Band 06", "Band 07", "Band 08", "Band 09", "Band 10", "Band 11", "Band 12", "Band 13", "Band 14", "Band 15", "Band 16", "Band 17", "Band 18", "Band 19", "Band 20"), Operator:=xlFilterValues 

' DO NOT SORT ACCORDING TO ORDER QUANTITY. 
' THIS IS BECAUSE THERE ARE INSTANCES, 
' WHERE THE SAME STYLE NUMBER IS BROKEN INTO SEVERAL POS EACH HAVING VARYING ORDER QUANTITIES 

'Restore ScreenUpdating, Calculation, EnableEvents, .... 
    My_Range.Parent.Select 
    ActiveWindow.View = ViewMode 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = CalcMode 
    End With 

End Sub 

Function LastRow(sh As Worksheet) 
    On Error Resume Next 
    LastRow = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlValues, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row 
    On Error GoTo 0 
End Function