Sub test()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim letzte As Long, zeile As Long
letzte = ActiveSheet.Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wksQuelle = ActiveSheet
Sheets.Add After:=ActiveSheet
Set wksZiel = ActiveSheet
wksQuelle.Range("A2:A" & letzte).Copy wksZiel.Range("A2")
With wksZiel
.Range("A2:A" & letzte).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For zeile = letzte To 2 Step -1
If .Cells(zeile, 1).Value = .Cells(zeile - 1, 1).Value Then
.Cells(zeile, 1).EntireRow.Delete
End If
Next zeile
letzte = ActiveSheet.Range("A65536").End(xlUp).Row
.Range("A2:A2" & letzte).Copy wksQuelle.Range("B2")
.Delete
End With
wksQuelle.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Gruß
Chris
Sub test()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim letzte As Long, zeile As Long
letzte = ActiveSheet.Range("BF65536").End(xlUp).Row ' letzte Zeile in Spalte BF = Quelle
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wksQuelle = ActiveSheet
Sheets.Add After:=ActiveSheet
Set wksZiel = ActiveSheet
wksQuelle.Range("BF2:B" & letzte).Copy wksZiel.Range("A2") ' Kopieren ins Hilfssheet
With wksZiel
.Range("A2:A" & letzte).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal ' sortieren im Hilfssheet
For zeile = letzte To 2 Step -1 ' doppelte löschen im Hilfssheet
If .Cells(zeile, 1).Value = .Cells(zeile - 1, 1).Value Then
.Cells(zeile, 1).EntireRow.Delete
End If
Next zeile
letzte = ActiveSheet.Range("A65536").End(xlUp).Row ' letzte im Hilfssheet
.Range("A2:A" & letzte).Copy wksQuelle.Range("B2") ' und für B2 deine Zielspalte, also z.B. _
Spalte H, dann H2 (Zurückkopieren ins Sheet)
.Delete ' Löschen des Hilfssheets
End With
wksQuelle.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Hoffe du hast es verstanden.
Gruß
Chris
Sub Makro1()
Dim QuelleTabelle As Worksheet
Dim QuelleSpalte As Range
Dim ZielTabelle As Worksheet
Dim ZielSpalte As Range
Set QuelleTabelle = ActiveSheet
Set ZielTabelle = ActiveSheet
Set QuelleSpalte = Range(QuelleTabelle.Cells(1, "A"), QuelleTabelle.Cells(65536, "A").End(xlUp)) _
Set ZielSpalte = ZielTabelle.Cells(1, "B")
QuelleSpalte.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ZielSpalte, Unique:=True
End Sub
Gruß, Daniel