VBA to split cells

Try this.

Sub SplitStuff()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long

    With Sheets("BEFORE")
        arrIn = .Range("A7", .Cells(7, Columns.Count).End(xlToLeft)).Value
    
        ReDim arrOut(1 To 2, 1 To UBound(arrIn, 2))
        
        For I = 1 To UBound(arrIn, 2)
            If InStr(arrIn(1, I), "/") > 0 Then
                arrOut(1, I) = Split(arrIn(1, I), "/")(1)
                
                arrOut(2, I) = Split(arrIn(1, I), "/")(0)
            Else
                arrOut(2, I) = arrIn(1, I)
            End If
        Next I
        
        .Range("A6").Resize(2, UBound(arrOut, 2)).Value = arrOut
        
        .Rows(1).Resize(5).Delete
        
    End With
    
End Sub

Select allOpen in new window

thanks Norie.  it brings the change into my existings sheet.  how can i modify this, so that it create the new worksheet "After" and pastes the data there?

Is the heading the only difference???

yes. only headings to be split as it is shown in the worksheet "AFTER"

simply put, i have the data as shown in worksheet "Before" and i need it to be added as new sheet like shown in the sheet "AFTER"

Is the 'AFTER' sheet an existing sheet or do you want to add a new sheet, call it 'AFTER', transfer the data from 'BEFORE' to it and then do the split?

in real work, i do not have "AFTER" worksheet. i have manually created it in this example, to show what i am looking for as result.

so, i only have the workbook called "BEFORE", so i need to run the macro, so that it creates the worksheet "AFTER"

You can use the standard substring function from excel to take the right part of the string,

I prefer VB-Functions over VB-Subroutines,

=GetPart(sourceCell;"/";1) gives the first label part
=GetPart(sourceCell;"/";2) gives the second label part
=GetPart(sourceCell;"/";3) would gives the third if ist exist

(You can replace the "/" by any other value (if required)

Function GetPart(dta As String, sep As String, part As Integer)

Dim DtaPart() As String

DtaPart = Split(dta, sep)
part = part - 1

GetaArt = DtaPart(part)

End Function

Select allOpen in new window

Norie,

Thank you so very much!

this is exactly what i was imagining.