'sortowanie
For i = 0 To UBound(lista)
    For j = i + 1 To UBound(lista)
        If StrComp(Left(lista(i), 3) & Right(lista(i), 10), Left(lista(j), 3) & Right(lista(j), 10), vbTextCompare) = 1 Then
            tekst = lista(i)
                lista(i) = lista(j)
            lista(j) = tekst
        End If
    Next j
 Next i

Sub sort()
Dim lista, tekst As String, i As Integer, j As Integer
lista = Split(Arkusz1.TextBox1, vbNewLine) 'rozbicie tekstu na wiersze ze względu na znak końca linii
 'sortowanie
For i = 0 To UBound(lista)
    For j = i + 1 To UBound(lista)
        If StrComp(lista(i), lista(j), vbTextCompare) = 1 Then
            tekst = lista(i)
                lista(i) = lista(j)
            lista(j) = tekst
        End If
    Next j
 Next i
tekst = ""
'przygotowanie nowego tekstu
For i = 0 To UBound(lista)
If lista(i) <> "" And lista(i) <> "OR" Then 'nie działaj gdy wiersz jest pusty lub "OR"
tekst = tekst & lista(i) & vbNewLine 'przygotuj nowy wiersz ze znakiem końca linii
    
    If i < UBound(lista) Then 'nie działaj dla ostatniego wiersza
        If Left(lista(i + 1), 3) <> Left(lista(i), 3) Then 'sprawdzaj czy pierwsze trzy znaki biżącego wiersza i nastepnego są różne ewentualnie ucase
            tekst = tekst & vbNewLine
                tekst = tekst & "OR" & vbNewLine
                    tekst = tekst & vbNewLine
                        End If
    End If
End If
Next i


Arkusz1.TextBox1.Value = tekst 'zapisz dane do textboxa

End Sub