If tbla(1, j) = kol(i) Then tbla1(j) = 1
Next i
If tbla1(j) = "" Then tbla1(j) = 0

Sub unikaty()
Dim i As Long, j As Long, tbla, tbla1(), ostatnia As Long, adres As Range, liczba As Integer, kol As New Collection
Dim a As String
On Error Resume Next
Set adres = Application.InputBox("Kliknij na dowolną komórkę w kolumnie z której mają być wyszukane unikaty ", Type:=8)
If adres Is Nothing Then Exit Sub
liczba = Application.InputBox("Podaj ilość unikatów")
On Error GoTo 0
If liczba = 0 Then Exit Sub
With adres.Parent
ostatnia = .Columns(adres.Column).Find(What:="*", After:=.Cells(1, adres.Column), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
tbla = .Range(.Cells(1, adres.Column), .Cells(ostatnia, adres.Column))
On Error Resume Next
For i = ostatnia To 1 Step -1
kol.Add tbla(i, 1), CStr(tbla(i, 1))
Next i
On Error GoTo 0
If kol.Count < liczba Then liczba = kol.Count
End With
'wyprowadzenie
Set adres = Nothing
On Error Resume Next
Set adres = Application.InputBox("Kliknij na dowolną komórkę w wierszu w której znajdują się kody.", Type:=8)
On Error GoTo 0
If adres Is Nothing Then Exit Sub
With adres.Parent
ostatnia = .Rows(adres.Row).Find(What:="*", After:=.Cells(adres.Row, 1), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
tbla = .Range(.Cells(adres.Row, 1), .Cells(adres.Row, ostatnia))
ReDim tbla1(1 To ostatnia)
For j = 1 To ostatnia
For i = 1 To liczba
a = kol(i)
If tbla(1, j) = kol(i) Then tbla1(j) = 1
Next i
If tbla1(j) = "" Then tbla1(j) = 0
Next j
.Range(.Cells(adres.Row + 1, 1), .Cells(adres.Row + 1, ostatnia)) = tbla1
End With
End Sub

Sub unikaty()
Dim i As Long, tbla, ostatnia As Long, adres As Range, liczba As Integer, kol As New Collection
Set adres = Application.InputBox("Kliknij na dowolną komórkę w kolumnie z której mają być wyszukane unikaty ", Type:=8)
If adres Is Nothing Then Exit Sub
On Error Resume Next
liczba = Application.InputBox("Podaj ilość unikatów")
On Error GoTo 0
If liczba = 0 Then Exit Sub
With adres.Parent
ostatnia = .Columns(adres.Column).Find(What:="*", After:=.Cells(1, adres.Column), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
tbla = .Range(.Cells(1, adres.Column), .Cells(ostatnia, adres.Column))
On Error Resume Next
For i = ostatnia To 1 Step -1
kol.Add tbla(i, 1), CStr(tbla(i, 1))
Next i
On Error GoTo 0

If kol.Count < liczba Then liczba = kol.Count
Workbooks.Add
For i = 1 To liczba
Cells(i, 1) = kol(i)
Next i
End With
End Sub

Sub subDuplikaty()
' zalozenie:
' 1. liczby sa w kolumnie A i nie ma pomiedzy nimi pustych komorek
' 2. arkusz wejsciowy i wyjsciowy maja taka sama kolejnosc numerow
' 3. 0/1 wstawiam do kolumny B w arkuszu wyjsciowym

  Dim arkWejscie As Worksheet ' arkusz z danymi wejsciowymi
  Dim arkWyjscie As Worksheet ' arkusz z danymi wyjsciowymi
  Dim lngIloscNumerow As Long ' ilosc numerow do pobrania
  Dim lngIndeksNumeru ' indeks numeru do pobrania
  Dim lngOstatniWiersz As Long ' ostatni wypelniony wiersz
  Dim lngPierwszyWierszy As Long ' pierwszy wiersz do pobrania
  Dim lngIndeksWiersza As Long ' indeks wiersza
  Dim lngSumaJedynek As Long ' suma jedynek

  On Error GoTo blad
  
  ' wybranie arkuszy
  Set arkWejscie = Worksheets(InputBox("Podaj nazwę arkusza wejściowego:", "Wejście", "wejscie"))
  If arkWejscie Is Nothing Then GoTo blad
  Set arkWyjscie = Worksheets(InputBox("Podaj nazwę arkusza wyjściowego:", "Wyjście", "wyjscie"))
  If arkWyjscie Is Nothing Then GoTo blad
  
  ' pytanie o ilosc wierszy
  lngIloscNumerow = CInt(InputBox("Podaj ilość numerów do pobrania:", "Ilość", "260"))
  
  ' wypelniene 0 lub 1 arkusza wejsciowego
  ' przeliczanie w nowym arkuszu
  lngOstatniWiersz = arkWejscie.Range("A1").End(xlDown).Row
  arkWyjscie.Columns(3).Clear
  Worksheets.Add
  ActiveSheet.Name = "pomoc"
  lngSumaJedynek = lngIloscNumerow
  Do
    Cells.Clear
    lngPierwszyWierszy = lngOstatniWiersz - (lngIloscNumerow - 1) - (lngIloscNumerow - lngSumaJedynek)
    arkWejscie.Range("A" & lngPierwszyWierszy & ":A" & lngOstatniWiersz).Copy Range("B1")
    Range("A1").Value = lngPierwszyWierszy
    lngIndeksNumeru = lngIloscNumerow + (lngIloscNumerow - lngSumaJedynek)
    Range("A1").AutoFill Destination:=Range("A1:A" & lngIndeksNumeru), Type:=xlFillSeries
    Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending, _
                        Key2:=Range("A1"), Order2:=xlDescending, _
                        Header:=xlNo, Orientation:=xlTopToBottom
    lngSumaJedynek = 1
    Cells(1, 3).Value = 1
    For lngIndeksWiersza = 2 To lngIndeksNumeru
      If Cells(lngIndeksWiersza, 2).Value = Cells(lngIndeksWiersza - 1, 2).Value Then
        Cells(lngIndeksWiersza, 3).Value = 0
      Else
        Cells(lngIndeksWiersza, 3).Value = 1
        lngSumaJedynek = lngSumaJedynek + 1
      End If
    Next
  Loop Until lngSumaJedynek = lngIloscNumerow
  
  ' koniec
  Columns("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending, _
                      Header:=xlNo, Orientation:=xlTopToBottom
  Range("C1:C" & lngIndeksNumeru).Copy arkWyjscie.Range("B" & Cells(1, 1).Value)

blad:
  Set arkWejscie = Nothing
  Set arkWyjscie = Nothing
  
koniec:
  Application.DisplayAlerts = False
  Worksheets("pomoc").Delete
  Application.DisplayAlerts = True
  MsgBox "Koniec", vbInformation, "Koniec"
  
End Sub