Transform column to row. And marge some data.

Add a sheet and name it "Sheet1". Select your Arkusz1 sheet. The macro assumes that you have headers in row 1 and your data is in columns A and B starting in row 2. Try:

Sub dosi()
    Application.ScreenUpdating = False
    Dim rngUniques As Range
    Dim rng As Range
    Dim LastRow As Long
    LastRow = Sheets("Arkusz1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Arkusz1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Arkusz1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Arkusz1").FilterMode Then Sheets("Arkusz1").ShowAllData
    For Each rng In rngUniques
        Range("A1:B" & LastRow).AutoFilter Field:=1, Criteria1:=rng
        Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = rng
        Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Next rng
    If Sheets("Arkusz1").FilterMode Then Sheets("Arkusz1").ShowAllData
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

another option

Option Explicit

Sub dosi()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lc As Long, lr2 As Long
    Set s1 = Sheets("Arkusz1")
    Set s2 = Sheets("Sheet1")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row

    With s1
        For i = 3 To lr    'change your starting row as necessary
            lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
            lc = s2.Cells(lr2, Columns.Count).End(xlToLeft).Column
            If .Range("A" & i) <> .Range("A" & i - 1) Then
                .Range("A" & i & ":B" & i).Copy s2.Range("A" & lr2 + 1)
            Else: .Range("B" & i).Copy s2.Cells(lr2, lc + 1)
            End If
        Next i
    End With
End Sub