高级过滤器以复制到新工作表

时间:2018-05-14 09:50:47

标签: excel vba excel-vba

我正在尝试自动过滤列,并将所有唯一值复制/粘贴到新的工作表中。这是我一直在使用的代码,但是在运行代码时我遇到了这个错误:

运行时错误' 1004':提取范围的字段名称丢失或无效。

gitlab

1 个答案:

答案 0 :(得分:0)

您可以使用集合来过滤掉唯一的项目,而不是使用高级过滤器。

Sub UsingCollection()
    Dim cUnique As Collection, ws As Worksheet, fRng As Range
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant

    Set sh = ThisWorkbook.Sheets("Filter This")
    Set Rng = sh.Range("C2:C" & sh.Cells(sh.Rows.Count, "C").End(xlUp).Row)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0

    For Each vNum In cUnique
        With sh
            Set fRng = .Range("C1:H" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        End With
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        With ws
            .Name = vNum
            With fRng
                .AutoFilter Field:=3, Criteria1:=vNum
                fRng.Copy ws.Range("A1")
            End With
            .AutoFilterMode = False
        End With
    Next vNum

End Sub