Split one row of data to columns and rows

Phew !!! such a long number. Is it obtained through some concatenation?

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

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

Originally Posted by arlu1201

Phew !!! such a long number. Is it obtained through some concatenation?

this is just a sample, its to much longer

Originally Posted by JBeaucaire

1) The coloring doesn't exist in your original data?
2) Your string is 450 digits long... you always want to split in the exact same number of digits?
3) Or is your string of any length, and we need to break each set of 50 characters as shown?

1- No, I colored to be clear
2- No, this is just a sample
3- exactly, 50 characters in row


thannx for your interest

actually I don't need the formatting

I attached the file after add and run the macro

it should be :
No.1: 6 digits
No.2: 4 digits
No.3: 13 digits
No.4: 11 digits
No.5: 16 digits

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, 6)
            Sheets(2).Range("B" & uRows).Value = Right(Left(dVal, 10), 4)
            Sheets(2).Range("C" & uRows).Value = Right(Left(dVal, 23), 13)
            Sheets(2).Range("D" & uRows).Value = Right(Left(dVal, 34), 11)
            Sheets(2).Range("E" & uRows).Value = Right(Left(dVal, 50), 16)
        
        dVal = vbNullString
Next w
End Sub

this one works with me

thanx a lot Steffen