Split one row of data to columns and rows

Originally Posted by Steffen Thomsen

This splits your numbers and places then the correct places.
Dont know bout keeping the formatting.

Sub test()

Dim loopcounter As Integer
Dim curStr As String
counter1 = 1
counter2 = 50

curStr = Sheets(1).Range("A1").Text

loopcounter = Len(curStr) / 50

For w = 1 To loopcounter
        dVal = Mid(curStr, counter1, counter2)
        counter1 = counter1 + 50
        
            uRows = Sheets(2).UsedRange.Rows.count + 1
            
            Sheets(2).Range("A" & uRows).Value = Left(dVal, 4)
            Sheets(2).Range("B" & uRows).Value = Right(Left(dVal, 10), 6)
            Sheets(2).Range("C" & uRows).Value = Right(Left(dVal, 23), 10)
            Sheets(2).Range("D" & uRows).Value = Right(Left(dVal, 34), 23)
            Sheets(2).Range("E" & uRows).Value = Right(Left(dVal, 50), 34)
        
        dVal = vbNullString
Next w
End Sub

Steffen Thomsen

thanx a lot Steffen, its works, but not correctly split to the table.

yes it's split correctly but as i said the formattings gone.

Those splits that arent long enough needs an amount of 0 in front of it.

Steffen Thomsen

This should work!

Sub test()

Dim loopcounter As Integer
Dim curStr As String
counter1 = 1
counter2 = 50


curStr = Sheets(1).Range("A1").Text

loopcounter = Len(curStr) / 50

For w = 1 To loopcounter
        dVal = Mid(curStr, counter1, counter2)
        
        counter1 = counter1 + 50
        
            uRows = Sheets(2).UsedRange.Rows.count + 1
            
            Sheets(2).Range("A" & uRows, "E" & uRows).NumberFormat = "@"
            Sheets(2).Range("A" & uRows).Value = Left(dVal, 4)
            Sheets(2).Range("B" & uRows).Value = Right(Left(dVal, 10), 6)
            Sheets(2).Range("C" & uRows).Value = Right(Left(dVal, 23), 10)
            Sheets(2).Range("D" & uRows).Value = Right(Left(dVal, 34), 23)
            Sheets(2).Range("E" & uRows).Value = Right(Left(dVal, 50), 34)
        
        dVal = vbNullString
Next w
End Sub

Steffen Thomsen

* Edit

Let me know if it's working for you