Lave to kopier af mange celler

Koden indsættes i Ark1 (højreklik - Vis programkode) og gang igangsættes i VBA-vinduet eller fra regnearket efter åbning m/Alt+F8.

Dim antalRæk, dupRæk
Sub duplicering()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    dupRæk = 1
   
    For r = 1 To antalRæk
        navn = Cells(r, 1)
        Cells(dupRæk, 2) = navn
        Cells(dupRæk + 1, 2) = navn
        dupRæk = dupRæk + 2
    Next r
End Sub

Det virker perfekt.

Mange tak.

Selv tak...