Tekst fra Word ind i Excel.

hvor mange blanke linier er der mellem hver label (når det råt er importeret i excel ?  og er det konsekvent ?

Er det altid 4 liniers labels ?

Kan du svare på dette kan det nok løses..

Der er faktisk altid 5 linier. Der er ingen blanke linier, det hele kommer lige efter hinanden. Jeg har gemt det som en tekst fil i Word og åbnet den i Excel.

Prøv at køre denne makro
forudsætninger:
Dine data står i kolonnne A, start ved række 1.
De nye kolonner starter ved B1, du sætter selv overskrifter bagefter

Option Explicit
Option Base 1

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 = 5 'Recordsize

lLastRow = Range("A65536").End(xlUp).Row
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

Virker fint, men hvad hvis adressen er på 5 linier istedet for 4? Har prøvet at rette der hvor der står recordsize til 6 men så melder den blot fejl.

ok, så skulle det være rettet

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

No-shit, er det noget shit.... ?

Eller i Word vælg hele listen, Tabel, konvertér, tekst til tabel, angiv 5 kolonner, kopier derefter hele tabellen til excel. Bingo

>>>bak: Det virkede helt fint. Mange tak. Vil du have dine point?

Ja tak :-)

God ide, softcarecunsult. Har lige testet og virker ok....