VBA 将不同工作簿中的自动过滤器设置为 Select 所有列

Question

我将报告中的数据提取到 Excel 中，然后我使用此代码验证是否打开了另一个工作簿（对于本示例，它将是 "Swivel - Master - January 2016.xlsm"）。如果目标工作簿处于打开状态，则子程序会将有效数据复制到目标工作簿。目标工作簿为列 A:AE 打开了筛选器。我需要做的是让 sub 将所有过滤器更改为 "Select All"，以便在将有效数据复制到它之前没有隐藏行。我已经在 SO 中查找了这个，但我找不到任何符合我正在寻找的东西。我还录制了一个宏，看看它是否会起作用，但它没有。不确定如何完成此操作。预先感谢您的帮助。

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

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

    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

Answer 1

将此代码放在要复制/粘贴的循环之前（我认为）。

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

或者，如果将 FilterMode 保持打开状态不是问题（意思是如果将其保持在没有过滤箭头出现的状态），只需执行以下操作：

Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel").AutoFilterMode = False

VBA 将不同工作簿中的自动过滤器设置为 Select 所有列

VBA to set autofilter in a differnt workbook to Select All for all columns

excel

vba

excel-2007

filter