Szukam alternatywy dla tego kodu. Muszę wybrać wszystkie wiersze z nazwą "Eksportuj 1", "Eksportuj 2" i tak, z wyłączeniem "testu eksportu"

Sub CopyManager()
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim valsArray As Variant


     valsArray = Array("Export *") '<--| define your values to be filtered on Source sheet column A
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Export")

    With Source  '<--| reference Source sheet
        With .Range("A1:A1000")  '<--| reference its range from A1 to A1000
            .AutoFilter Field:=1, Criteria1:=valsArray, Operator:=xlFilterValues   '<--| filter referenced range on its first column with values stored in valsArray
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than
                .Resize(.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Target.Range("A2") '<--|copy filtered cells skipping headers and paste in target sheet from cell A1
                .Resize(.Rows.Count - 1, 1).Offset(1, 4).SpecialCells(xlCellTypeVisible).Copy Target.Range("B2")
            End If
        End With
        .AutoFilterMode = False
    End With

End Sub

Powyższy kod kopiuje wszystkie wiersze z nazwą "Eksportuj 1", "Eksportuj 2" i tak dalej, a także obejmuje "test eksportowy", ale muszę wykluczyć "test eksportowy"

0
Pavan 25 luty 2019, 12:05

2 odpowiedzi

Najlepsza odpowiedź

Możesz dodać drugie kryteria w autofilterie.
Zmień operatora do =xlAnd i dodaj z wyłączeniem CITERIA z <>:

.AutoFilter Field:=1, Criteria1:=valsArray, Operator:=xlAnd, Criteria2:="<>Export test"

Oczywiście można mieć te kryteria, które będą zmienne, tak jak w razie potrzeby kryteria filtrowania.

0
Christofer Weber 25 luty 2019, 09:22

Nie jestem pewien, ale jednym z możliwych rozwiązań jest

Zastąpić

.AutoFilter Field:=1, Criteria1:=valsArray, Operator:=xlFilterValues 

Z:

.AutoFilter Field:=1, Criteria1:="<>*Export Test*", Operator:=xlAnd
0
Error 1004 25 luty 2019, 09:25