Autofilter Ошибка времени выполнения '91' VBA

Question

Мне нужна ваша помощь.

Я хотел бы автофильтировать столбец таблицы со следующим значением: начинается с AF. А затем скопируйте и вставьте несколько столбцов на другой лист.

Я написал код, но я alwasy получаю сообщение об ошибке, когда код достигнет следующую строку:

.AutoFilter поле: = rng0.Column, факторам1: = SearchFor

Ошибка является: переменная объекта или с блоком не установлен.

Я понятия не имею, что не так с кодом. Пожалуйста, помогите мне.

Sub AF_update() 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

SearchCol0 = "Prefix+short name" 
SearchCol1 = "Site type" 
SearchCol2 = "SLA Target" 
SearchCol3 = "Mean Rtt (ms)" 
SearchCol4 = "Max Rtt (ms)" 
SearchCol5 = "Threshold 95%" 
SearchCol6 = "Threshold 99%" 
SearchFor = "=AF*" 

Dim rng0, rng1, rng2, rng3, rng4, rng5, rng6 As Range 
Dim lastrow As Long 

Set rng0 = ActiveSheet.UsedRange.Find(SearchCol0, , xlValues, xlWhole) 
Set rng1 = ActiveSheet.UsedRange.Find(SearchCol1, , xlValues, xlWhole) 
Set rng2 = ActiveSheet.UsedRange.Find(SearchCol2, , xlValues, xlWhole) 
Set rng3 = ActiveSheet.UsedRange.Find(SearchCol3, , xlValues, xlWhole) 
Set rng4 = ActiveSheet.UsedRange.Find(SearchCol4, , xlValues, xlWhole) 
Set rng5 = ActiveSheet.UsedRange.Find(SearchCol5, , xlValues, xlWhole) 
Set rng6 = ActiveSheet.UsedRange.Find(SearchCol6, , xlValues, xlWhole) 



Set Target = ThisWorkbook.Worksheets("AF") 
Set Source = ThisWorkbook.Worksheets("RAW DATA") 

Target.Select 

Range("A2").Select 
Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select 
Selection.ClearContents 

    Source.Select 

    If ActiveSheet.AutoFilterMode = True Then 
     Range("a1").AutoFilter 
    End If 

    Range("A1").Select 
    With Selection 
    .AutoFilter Field:=rng0.Column, Criteria1:=SearchFor 
    End With 


    rng0.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng1.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("B2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng2.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("C2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng3.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("D2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng4.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("E2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng5.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("F2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Source.Select 
    rng6.Offset(1, 0).Select 
    Range(Selection, Selection.End(xlDown)).Copy 
    Target.Select 
    Range("G2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 



    lastrow = Cells(Rows.Count, 5).End(xlUp).Row 
    Range("A2:G" & lastrow).Sort key1:=Range("E2:E" & lastrow), order1:=xlDescending, Header:=xlNo 

Source.Select 
ActiveSheet.AutoFilterMode = False 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 

MsgBox "Operation Completed!" 
End Sub 

Answer 1

Я очистил ваш код; в первую очередь устраняя зависимость от .Select ¹ и .Activate ¹, но также беря группы переменных и создавая массивы для каждой группы. Это позволило использовать циклы, которые значительно сократили код, позволяя использовать полную функциональность.

Sub AF_update() 
    Dim v As Long, vSearchCols As Variant, vCols As Variant, FilterFor As String 
    Dim Source As Worksheet, Target As Worksheet 

    'Application.ScreenUpdating = False 
    'Application.DisplayAlerts = False 
    'Application.EnableEvents = False 

    FilterFor = "AF*" 

    Set Source = ThisWorkbook.Worksheets("RAW DATA") 
    With Source 
     'array of 'SearchCol' values on a zero-based index 
     vSearchCols = Array("Prefix+short name", "Site type", "SLA Target", "Mean Rtt (ms)", _ 
          "Max Rtt (ms)", "Threshold 95%", "Threshold 99%") 
     ReDim vCols(0 To UBound(vSearchCols)) 'make them the same size 
     For v = LBound(vSearchCols) To UBound(vSearchCols) 
      vCols(v) = .Rows(1).Cells.Find(What:=vSearchCols(v), LookIn:=xlFormulas, LookAt:=xlWhole).Column 
     Next v 
    End With 

    Set Target = Worksheets("AF") 
    With Target 
     If .AutoFilterMode Then .AutoFilterMode = False 
     With .Cells(1, 1).CurrentRegion 
      Debug.Print .Cells(.Rows.Count - 1, .Columns.Count).Address(0, 0, external:=True) 
      .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).ClearContents 
     End With 
    End With 

    With Source 
     If .AutoFilterMode Then .AutoFilterMode = False 
     With .Cells(1, 1).CurrentRegion 
      .AutoFilter Field:=vCols(0), Criteria1:=FilterFor 

      'check to see if there is anything to copy across 
      With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 
       If CBool(Application.Subtotal(103, .Cells)) Then 
        'there is something to transfer; loop through the ranges 
        For v = LBound(vCols) To UBound(vCols) 
         .Columns(vCols(v)).Copy 
         Target.Cells(2, v + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
                  SkipBlanks:=False, Transpose:=False 
        Next v 
       End If 
      End With 
     End With 
    End With 

    With Target 
     With .Cells(1, 1).CurrentRegion 
      With .Resize(.Rows.Count, 7) 
       .Cells.Sort Key1:=.Columns(5), Order1:=xlDescending, _ 
          Orientation:=xlTopToBottom, Header:=xlYes 
      End With 
     End With 
    End With 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 

    MsgBox "Operation Completed!" 
End Sub 

Вы можете пройти через код с повторными F8 кранами. Я временно прокомментировал изменения вашей среды приложений.

При работе с блоком или «островом» данных, происходящих из А1, Range.CurrentRegion property является быстрым и эффективным методом выделения данных при ссылке на With ... End With statement.

Мне пришлось угадать, на каком рабочем листе начался ваш макрокоманд. Я выбрал рабочий лист RAW DATA.

---

¹ _{См How to avoid using Select in Excel VBA macros для более методов на получение от полагаться на выбор и активировать для достижения ваших целей.}