VBA kode til at flytte data fra kolonner til linjer - opdatering

Jeg har en kode som henter data fra kolonne A til H og sorterer dem så de kommer til at stå i kolonne A til E.  (se nedenfor)

Koden virker super fint, men jeg vil meget gerne have den udvidet en smule.
Lige nu henter den tal fra kolonne D til H og sorterer.
Men jeg vil meget gerne at den henter tal fra kolonne D til kolonne M

Jeg har prøvet at rette i koden. men kan ikke hitte ud af den.
Er der nogen der kan hjælpe mig?

Fik oprindelig hjælp til koden her:
https://www.computerworld.dk/eksperten/spm/1022138


NUVÆRENDE OPSTILLING
A              B          C          D                  E            F              G            H
Bilag    Dato        Tekst        Konto 1    Konto 2    Konto 3    Konto 4    Konto
                                                1000        1010        1020    5800    5820

1    01-01-2017  diverse          -400      -500    -100        800              100
2    02-01-2017  altmuligt        -1500          0          0          900              400
osv.

Efter koden er kørt ser det således ud:
A    B                      C            D            E 
1    01-01-2017    1000    diverse    -400
1    01-01-2017    1010    diverse    -500
1    01-01-2017    1020    diverse    -100
1    01-01-2017    5800    diverse    800
1    01-01-2017    5820    diverse    100
2    02-01-2017    1000    altmuligt    -1500
2    02-01-2017    1010    altmuligt    0
2    02-01-2017    1020    altmuligt    0
2    02-01-2017    5800    altmuligt    900
2    02-01-2017    5820    altmuligt    400


KODE:

Option Base 1

Sub FlytData()
Dim MyArray()
Dim AntRk As Integer, i As Integer, j As Integer

If ActiveCell.Offset(1, 0).Value = "" Then
    AntRk = 1
Else
    AntRk = Range(ActiveCell, ActiveCell.End(xlDown)).Rows.Count
End If

ReDim MyArray(5, AntRk * 5)
i = 1
Do While ActiveCell.Value <> ""
   
    For j = 1 To 5
        MyArray(1, i) = ActiveCell.Value
        MyArray(2, i) = ActiveCell.Offset(0, 1).Value
        MyArray(3, i) = Cells(2, j + 3).Value
        MyArray(4, i) = ActiveCell.Offset(0, 2).Value
        MyArray(5, i) = ActiveCell.Offset(0, j + 2).Value
        i = i + 1
    Next
    ActiveCell.Offset(1, 0).Select
Loop
   
ActiveWorkbook.Sheets.Add
With ActiveSheet
    .Cells(1, 1) = "Bilag"
    .Cells(1, 2) = "Dato"
    .Cells(1, 3) = "Konto"
    .Cells(1, 4) = "Tekst"
    .Cells(1, 5) = "Beløb"
    For i = 1 To AntRk * 5
        For j = 1 To 5
            .Cells(i + 1, j) = MyArray(j, i)
        Next
    Next
End With

End Sub