Kolonner til rækker

Har fundet et andet svar, som jeg har kunne modificere lidt og det virker. Hvis den kan gøres bedre (og gerne oversættes til dansk) er jeg dog stadig meget interesseret.

Sub FlytData()
Dim Koll As Integer
Dim Rækk As Integer
Dim NyeData As Integer

NyeData = 2
        Rækk = 2
          While Len(Ark1.Cells(Rækk, 1).Value) > 0
          For Koll = 4 To 13
                If Len(Ark1.Cells(Rækk, Koll).Value) > 0 Then
                Ark2.Cells(NyeData, 1) = Ark1.Cells(Rækk, 1).Value
                Ark2.Cells(NyeData, 2) = Ark1.Cells(Rækk, 2).Value
                Ark2.Cells(NyeData, 3) = Ark1.Cells(Rækk, 3).Value
                Ark2.Cells(NyeData, 4) = Ark1.Cells(1, Koll).Value
                Ark2.Cells(NyeData, 5) = Ark1.Cells(Rækk, Koll).Value
                NyeData = NyeData + 1
                End If
                     
            Next Koll
              Rækk = Rækk + 1
            Wend
  End Sub