Word til excel (MAKRO)

Jeg har tidligere fået hjælp til at lave en makro, som skulle lave labels for mig.

Det den skal gøre er at få:

Linie 1
Linie 2
Linie 3
Linie 4
Linie 5
osv.

til at stå sådan:

Linie 1    Linie 2    Linie 3      Linie 4    Linie 5
Linie 6    osv.

Altså så jeg kan flette udfra det.


Problemet med makroen er at den kun tager 4 linier med og at den springer nogle over. F.eks. kommer det til at se sådan ud:

Linie 1    Linie 2    Linie 3      Linie 4    Linie 5
Linie 7    Linie 8

Der er altid 5 linier i hver adresse.

Sub TransponerArray()
Dim lCounter As Long
Dim lLastRow As Long
Dim lTest As Long
Dim lCounter2 As Long
Dim vOldArray
Dim vNewArray

Const sInsertHere As String = "B1"
Const lFirstRow As Long = 1
Const lRecSize As Long = 6 'Recordsize

lLastRow = Range("A65536").End(xlUp).Row
lLastRow = ((lLastRow \ lRecSize) + 1) * lRecSize
vOldArray = Range("a" & lFirstRow & ":a" & lLastRow)
ReDim vNewArray((lLastRow \ lRecSize) + 1, lRecSize)
For lCounter = 1 To lLastRow Step lRecSize
    lTest = lTest + 1
        For lCounter2 = 1 To lRecSize
            vNewArray(lTest, lCounter2) = vOldArray(lCounter + lCounter2 - 1, 1)
        Next
Next
Range(sInsertHere).Resize(lTest, lRecSize - 1) = vNewArray

Set vOldArray = Nothing
Set vNewArray = Nothing
End Sub

Har virkelig brug for et hurtigt svar????