Sub darabol()
    usor = ActiveSheet.UsedRange.Rows.Count
    oszlop = 1: sor = 0
    Do While sor <= usor
        Range("A1:A50").Offset(sor, 0).Copy Cells(1, oszlop + 1) '**
        sor = sor + 51: oszlop = oszlop + 1 '**
    Loop
    Range("A51:A" & usor) = ""  '**
End Sub

Ez a makró 50 soros darabokra szabdalja az A oszlop adatait, és azokat a következő oszlopokba másolja.

3 helyre tettem megjegyzésbe **-ot, azokban a sorokban írd át az 50-et, ill. az 51-et a Nedek tetsző értékre.