excel - VBA过滤唯一值并将其复制到新工作表

Question

我想从列表中过滤唯一值并将它们复制粘贴到新工作表中。不幸的是，在删除之前提交过滤数据的新“Tabelle14”之后..通过对该宏进行另一次传导，这是不可能的，因为它不再识别“Tabelle14”。这种方法不起作用

  Sub Makro4()
    '
    ' Makro4 Makro
    '
    ' Tastenkombination: Strg+c
    '
        Sheets.Add After:=ActiveSheet
        Sheets("Tabelle1").Select
        Columns("K:K").Select
        ActiveSheet.Range("$K$1:$K$15").RemoveDuplicates Columns:=1, Header:=xlNo
        Selection.Copy
        Sheets("Tabelle14").Select
        Columns("H:H").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End Sub

这是另一种效果更好的方法，因为我不会从原始工作表中删除数据。我买不起的是数据被提交到另一张纸上。我试过 Destination:= instead CopyRange:=但我不知道如何解释将某些内容提交给不存在的新的未命名工作表的程序。我还尝试使用 Workbooks.Add 做一些事情和 ActiveSheet.Copy After:=Sheets(Sheets.Count)

Sub Unique_Values()

    ThisWorkbook.Worksheets("name").Activate
    Range("J:J").AdvancedFilter Action:=xlFilterCopy, _
                                CopyToRange:=Range("BO:BO"), _
                                Unique:=True
End Sub

谢谢你的帮助

Answer 1

新工作表的高级过滤器

Option Explicit

Sub Unique_Values()
    Dim wb As Workbook: Set wb = ThisWorkbook
    With wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        .Parent.Worksheets("name").Range("J:J").AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=.Range("BO:BO"), _
            Unique:=True
    End With
End Sub

Sub Unique_Values_Worksheet_Variables()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Worksheets("name")
    Dim dws As Worksheet
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    sws.Range("J:J").AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=dws.Range("BO:BO"), _
        Unique:=True
End Sub

Sub Unique_Values_Range_Variables()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim srg As Range: Set srg = wb.Worksheets("name").Range("J:J")
    Dim drg As Range
    Set drg = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Range("BO:BO")
    srg.AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=drg, _
        Unique:=True
End Sub