Sub kasuj_duplikaty()
   Const kP = "B" 'kolumna porównania
   Dim w As Long
   
   'ostatni wiersz w kolumnie porównania
   w = Cells(Cells.Rows.Count, kP).End(xlUp).Row
   
   Application.ScreenUpdating = False
   While w > 1
     If Application.CountIf(Range(Cells(w, kP), Cells(1, kP)), Cells(w, kP)) > 1 Then
       Cells(w, kP).EntireRow.Delete
     End If
     w = w - 1
   Wend
   Application.ScreenUpdating = True
End Sub

w = Cells(Cells.Rows.Count, kP).End(xlUp).Row

Sub kasuj_duplikaty()
  Const kP = "B" 'kolumna porównania
  Dim w As Long
  
  'ostatni wiersz w kolumnie porównania
  w = Cells(Cells.Rows.Count, kP).End(xlUp).Row
  
  Application.ScreenUpdating = False
  While w > 1
    If Cells(w, kP) = Cells(w - 1, kP) Then
      Cells(w, kP).EntireRow.Delete
    End If
    w = w - 1
  Wend
  Application.ScreenUpdating = True
End Sub

Option Explicit

Sub Wiersz(oCell As Range, ByRef startRow As Long, ByRef endRow As Long)

Dim k As Long

startRow = oCell.Row

Do While oCell.Value <> ""
  k = k + 1
  Set oCell = oCell.Offset(1, 0)
Loop

endRow = startRow + k - 1

End Sub
Sub Kolumna(oCell As Range, ByRef startCol As Long, ByRef endCol As Long)

Dim k As Long

startCol = oCell.Column

Do While oCell.Value <> ""
  k = k + 1
  Set oCell = oCell.Offset(0, 1)
Loop

endCol = startCol + k - 1

End Sub

Sub Dopp_Weg()

Dim oCell As Range

Dim startRow As Long
Dim endRow As Long
Dim startCol As Long
Dim endCol As Long
Dim KolumneNR As Long
Dim i As Long, m As Long, n As Long, k As Long
Dim cKlasse As Collection
Dim oEl, oEl2
Dim oKlasse As clsKlasse
Set cKlasse = New Collection

k = 0

Wiersz ActiveCell, startRow, endRow
Kolumna ActiveCell, startCol, endCol

Dim bJest As Boolean
bJest = False

For i = startRow To endRow
    For k = i + 1 To endRow
    'Numer kolumny służącej do porównywania, u nas jest to kolumna druga
        KolumneNR = 2
       If Cells(i, KolumneNR).Value = Cells(k, KolumneNR).Value Then bJest = True
    Next k
    
    If Not bJest Then
        Set oKlasse = New clsKlasse
        
        For k = startCol To endCol
            oKlasse.Col.Add Cells(i, k).Value
        Next k
        
        cKlasse.Add oKlasse
        Set oKlasse = Nothing
    End If
    bJest = False
Next i

Range(Cells(startRow, startCol), Cells(endRow, endCol)).Clear

m = startRow

For Each oEl In cKlasse
    n = startCol
    For Each oEl2 In oEl.Col
        Cells(m, n).Value = oEl2
        n = n + 1
    Next oEl2
    m = m + 1
Next oEl

End Sub

Public Col As Collection

Private Sub Class_Initialize()
    Set Col = New Collection
End Sub

Private Sub Class_Terminate()
    Set Col = Nothing
End Sub