篩選，復制和粘貼到新的WB中-工作表類的選擇方法失敗

Question

我是VBA和這個論壇的新手。 我正在嘗試將已過濾的數據從一個工作簿復制並粘貼到新工作簿。 我已經修改了http://www.rondebruin.nl/win/s3/win006_1.htm中的代碼，該代碼是為相同的功能而編寫的，但在工作表中。

修改代碼后，出現錯誤“ 1004：工作表類的選擇方法失敗”。 我已經用... （在代碼末尾）標記了錯誤行

有人可以幫忙指出出什么問題嗎？ 我的代碼如下：

    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