1

I am new to VBA and this forum. I am trying to copy and paste filtered data from one workbook to a new workbook. I have modified the code from http://www.rondebruin.nl/win/s3/win006_1.htm, which is written for the same function but within sheets.

After modifying the code, I get the error "1004: Select Method of Worksheet Class Failed". I have marked out the error line with ... (towards the end of the code)

Can someone help to point out what is wrong? My code is as below:

    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
Rory
  • 32,730
  • 5
  • 32
  • 35
arthurlgh90
  • 13
  • 2
  • While I usually don't like to recommend anything that uses [.Select](https://msdn.microsoft.com/en-us/library/office/ff197597.aspx) or [.Activate](https://msdn.microsoft.com/en-us/library/office/aa221681.aspx) (see [this](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)), have you tried `My_Range.Parent.Activate` ? At the beginning, you `Set My_Range = Range("A1:CR" & LastRow(ActiveSheet))` but there is absolutely no reference to the parent worksheet. –  Feb 24 '16 at 09:49

1 Answers1

1

You can't select a sheet unless that workbook is active, so add this before that line:

My_Range.Parent.Parent.Activate
Rory
  • 32,730
  • 5
  • 32
  • 35
  • Good catch! I was still trying to find out what worksheet/workbook **My_Range** belonged to. I guess by default it is the newly opened **WBOld**. –  Feb 24 '16 at 09:51