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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen