[英]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.
不幸的是,在删除之前提交过滤数据的新“Tabelle14”之后......通过使用此宏进行另一次传导,这是不可能的,因为它不再识别“Tabelle14”。 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.我尝试使用
Destination:= instead CopyRange:=
但我不知道如何解释程序以将某些内容提交给不存在的新的未命名工作表。 I also tried by doing something with Workbooks.Add
and ActiveSheet.Copy After:=Sheets(Sheets.Count)
我还尝试使用
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
Thanks for your help谢谢你的帮助
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.