从另一个工作簿中的另一个工作表执行工作簿中的Excel工作表上的过滤macros
我有两本工作书，Book_1和Book_2。
我写了一个macros来执行过滤function。
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插入一个模块并input编码，
并运行macros，
然后过滤发生。
………………………………………….. ……………………..
但是：这段代码不会让我在Book_1 worksheet_1中执行过滤，
如果我从Book_2 worksheet_1放置并执行macros。
我想从Book_2 worksheet1中执行Book_A工作表1中的筛选macros。
如何才能做到这一点？ 我如何编辑我的编码？
试试这个：
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