筛选，复制并粘贴到新的WB – select工作表类失败的方法
我是VBA和这个论坛的新手。 我正在尝试从一个工作簿复制和粘贴过滤的数据到一个新的工作簿。 我已经修改了http://www.rondebruin.nl/win/s3/win006_1.htm中的代码，它是为了相同的function而编写的。
修改代码后，出现错误“1004：工作表类失败的select方法”。 我已经用…标出了错误行（接近代码的结尾）
有人可以帮助指出什么是错的？ 我的代码如下：
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 除非该工作簿处于活动状态，否则无法select工作表，因此请在该行前加上：
My_Range.Parent.Parent.Activate