Search code examples
excelvbaadvanced-filter

VBA Filter Unique Values and copy those to a new sheet


I want to filter unique values form a list and copy paste them to a new sheet. Unfortunately after deleting the new "Tabelle14" to which the filtered data was submitted before ..by doing another conduction with this macro it is impossible because it does not recognize "Tabelle14" anymore. This approach does not work

  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

This was another approach which works much better just by the fact that i do not delete data from the original sheet. What i can not afford is that the data is submitted to another sheet. I tried with Destination:= instead CopyRange:= but I don't know how to explain the program to submit something to a new unnamed sheet which is not existing. I also tried by doing something with Workbooks.Add and 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

Thanks for your help


Solution

  • Advanced Filter to a New Worksheet

    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