Sub FormatujTabulku()
Dim Riadkov As Long, Meno(), MenoN(), Pocet As Long, y As Long, i As Long, d As Long, Adr As String, A As String, Vlozene As Boolean
  
  Application.ScreenUpdating = False
  
  With ThisWorkbook.Worksheets("Hárok1")
    Riadkov = .Cells(Rows.Count, 3).End(xlUp).Row - 1
    If Riadkov < 2 Then Exit Sub
    ReDim Meno(1 To Riadkov, 1 To 1)
    Meno = .Cells(2, 3).Resize(Riadkov).Value2
    
    For i = 1 To Riadkov
      Pocet = Pocet + 1
      ReDim Preserve MenoN(1 To 1, 1 To Pocet)
      
      If i > 1 Then
        If Meno(i, 1) <> Meno(i - 1, 1) Then
          Pocet = Pocet + 1
          ReDim Preserve MenoN(1 To 1, 1 To Pocet)
          MenoN(1, Pocet) = Meno(i, 1)
          
          y = y + 1
          A = .Cells(d + i + 1, 1).Resize(, 4).Address
          If Len(Adr) + Len(A) + 1 > 255 Then
            .Range(Adr).Insert Shift:=xlDown: Adr = "": Vlozene = True: d = d + y: y = 0
          Else
            Adr = Adr & IIf(Adr = "", "", ",") & A: Vlozene = False
          End If
          
        End If
      Else
        MenoN(1, Pocet) = Meno(i, 1)
      End If
    Next i
    
    If Vlozene = False Then .Range(Adr).Insert Shift:=xlDown
    .Cells(2, 3).Resize(Pocet).Value2 = WorksheetFunction.Transpose(MenoN)
  End With
  
  Application.ScreenUpdating = True
  Erase Meno: Erase MenoN
End Sub

Sub FormatujTabulkuPole()
Dim Riadkov As Long, Data(), DataN(), Pocet As Long, i As Long, Meno As Boolean
  
  Application.ScreenUpdating = False
  
  With ThisWorkbook.Worksheets("Hárok1")
    Riadkov = .Cells(Rows.Count, 3).End(xlUp).Row - 1
    If Riadkov < 2 Then Exit Sub
    ReDim Data(1 To Riadkov, 1 To 4)
    Data = .Cells(2, 1).Resize(Riadkov, 4).Value2
    Meno = True
    
    For i = 1 To Riadkov
      Pocet = Pocet + 1
      If i > 1 Then
        If Data(i, 3) <> Data(i - 1, 3) Then
          Pocet = Pocet + 1
          Meno = True
        Else
          Meno = False
        End If
      End If
      ReDim Preserve DataN(1 To 4, 1 To Pocet)
      DataN(1, Pocet) = Data(i, 1): DataN(2, Pocet) = Data(i, 2): DataN(4, Pocet) = Data(i, 4)
      If Meno Then DataN(3, Pocet) = Data(i, 3)
    Next i
    
    .Cells(2, 1).Resize(Pocet, 4).Value2 = WorksheetFunction.Transpose(DataN)
  End With
  
  Application.ScreenUpdating = True
  Erase Data: Erase DataN
End Sub