VBA 过滤唯一值并将其复制到新的 sheet

Question

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

  Sub Makro4()
    '
    ' Makro4 Makro
    '
    ' Tastenkombination: Strg+c
    '
        Sheets.Add After:=ActiveSheet
        Sheets("Tabelle1").Select
        Columns("K:K").Select
        ActiveSheet.Range("$K:$K").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

这是另一种效果更好的方法，因为我没有从原始 sheet 中删除数据。我不能承受的是数据被提交给另一个sheet。我尝试使用 Destination:= instead CopyRange:=，但我不知道如何解释该程序以向不存在的新的未命名 sheet 提交内容。我也尝试用 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

VBA 过滤唯一值并将其复制到新的 sheet

VBA Filter Unique Values and copy those to a new sheet

excel

vba

advanced-filter

新工作表的高级过滤器