Question

我是VBA和这个论坛的新手。我正在尝试将过滤后的数据从一个工作簿复制并粘贴到新工作簿。我修改了http://www.rondebruin.nl/win/s3/win006_1.htm中的代码，该代码是为相同的函数但在工作表内编写的。

修改代码后，我收到错误＆＃34; 1004：选择工作表类失败的方法＆＃34;。我已用 ... （在代码末尾）

标出了错误行

有人可以帮忙指出错误吗？我的代码如下：

    Sub Auto_Filter()
    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
    Dim WBOld As Workbook, WBNew As Workbook
    Dim WSOld As Worksheet, WSNew As Worksheet
    Dim WBName As String
    Dim rng As Range

    Set WBOld = Workbooks.Open("Users:arthurleeguanghui:Desktop:testfile.xlsm")
    Set WSOld = WBOld.Sheets("Master")

    Set My_Range = Range("A1:CR" & LastRow(ActiveSheet))
    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

    My_Range.Parent.AutoFilterMode = False

    My_Range.AutoFilter Field:=2, Criteria1:="=1"
    My_Range.AutoFilter Field:=3, Criteria1:="=2"
    CCount = 0
    On Error Resume Next
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
    On Error GoTo 0
    If CCount = 0 Then
        MsgBox "There are more than 8192 areas:" _
             & vbNewLine & "It is not possible to copy the visible data." _
             & vbNewLine & "Tip: Sort your data before you use this macro.", _
               vbOKOnly, "Copy to worksheet"
    Else
        Set WBNew = Workbooks.Add
        Set WSNew = WBNew.Sheets("Sheet1")

        WBName = InputBox("What is the name of the new workbook?", _
                             "Name the New WB")

        My_Range.Parent.AutoFilter.Range.Copy
        With WSNew.Range("A1")
            .PasteSpecial Paste:=8
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            .Select
        End With

    End If

    With WSOld
        My_Range.Parent.AutoFilterMode = False

        'Restore ScreenUpdating, Calculation, EnableEvents, ....
        **My_Range.Parent.Select**
        ActiveWindow.View = ViewMode
        If Not WSNew Is Nothing Then WSNew.Select

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

    End With

    WBNew.SaveAs Filename:="Users:arthurleeguanghui:Desktop:" & WBName & ".xlsx"

End Sub

Answer 1

除非该工作簿处于活动状态，否则您无法选择工作表，因此请在该行之前添加：

My_Range.Parent.Parent.Activate

过滤，复制并粘贴到新WB - 选择工作表类的方法失败

1 个答案: