Sub raport()
Dim unikat1 As New Collection, unikat2 As New Collection, licznik1 As Long, komunikat As String
With Sheets("Arkusz1")
'lista unikat1ów
On Error Resume Next
For licznik1 = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
unikat1.Add .Cells(licznik1, 1), CStr(.Cells(licznik1, 1))
Next licznik1
Err.Clear
'tworzenie komunikatu
For licznik1 = 1 To unikat1.Count
komunikat = komunikat & vbNewLine & unikat1(licznik1)
For licznik2 = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(licznik2, 1) = unikat1(licznik1) Then
    unikat2.Add .Cells(licznik2, 2), CStr(.Cells(licznik2, 2))
        If Err.Number = 0 Then komunikat = komunikat & vbNewLine & Cells(licznik2, 2)
    Err.Clear
End If
Next licznik2
Set unikat2 = New Collection
Next licznik1
On Error GoTo 0
End With
MsgBox komunikat
End Sub

Sub raport_new()
Dim unikat As New Collection, licznik As Long, komunikat As String
Dim komorka As Range

With Sheets("Arkusz1")
 'lista unikatów
 On Error Resume Next
  For Each komorka In Range("WYS") ' kol 'B'
   If komorka.Offset(0, -1).Value = "K1" Then
    unikat.Add komorka, CStr(komorka)
   End If
  Next komorka
 On Error GoTo 0
 'tworzenie komunikatu
 komunikat = "K1" & vbNewLine & unikat(1)
  For licznik = 2 To unikat.Count
   komunikat = komunikat & vbNewLine & unikat(licznik)
  Next licznik
End With

MsgBox komunikat
End Sub

Sub raport()
Dim unikat As New Collection, licznik As Long, komunikat As String
With Sheets("Arkusz1")
'lista unikatów
On Error Resume Next
For licznik = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
unikat.Add .Cells(licznik, 1), CStr(.Cells(licznik, 1))
Next licznik
On Error GoTo 0
'tworzenie komunikatu
komunikat = unikat(1)
For licznik = 2 To unikat.Count
komunikat = komunikat & vbNewLine & unikat(licznik)
Next licznik
End With
MsgBox komunikat
End Sub