Herhangi bir sütundaki verileri kontrol ettirerek aynı olanlardan yalnızca bir tanesini yazdırarak sıralatan makro. Verilerilerin A sütununda olduğu varsayımı ile.

Kod: Tümünü seç

Sub Doppelte_löschen()
    Range("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
      xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
      xlTopToBottom
    Range("A1").Select
    nr = ActiveCell
    zellende = Range("A" & Rows.Count).End(xlUp).Row
    Do
      ActiveCell.Offset(1, 0).Range("A1").Select
      If ActiveCell = nr Then
        Selection.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Range("A1").Select
      End If
      nr = ActiveCell
    Loop Until ActiveCell = Range("A" & zellende + 1)
End Sub