CODEWITHSUNDEEP
excelvbaadvanced-filter
Sven
Sven

Reputation: 101

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

Upvotes: 2

Views: 2528

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 1

Related Questions