Thread: Split column and create new row

Hello,

I have a spreadsheet with multiple columns. Each colunm has a single entrey except for column D (happens to be in the middle). Column D has multiple entries separated by £. I would like to take column D and split it and make a new row that duplicates columns A - C & E - G for each entry in column D. I'm using the following script but it does not copy the info from columns a-c and e-g.

Sub Splt()
Dim LR As Long, i As Long
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
Columns("K").Insert
For i = LR To 1 Step -1
With Range("E" & i)
If InStr(.Value, "£") = 0 Then
.Offset(, -1).Value = .Value
Else
X = Split(.Value, "£")
.Offset(1).Resize(UBound(X)).EntireRow.Insert
.Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End If
End With
Next i
Columns("E").Delete
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:J" & LR)
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]J"
On Error GoTo 0
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

I will thank you for your reply!

Cheers!
Jack

Here's an example of the spreadsheet. Please note that the code attached works to some extent but it does not copy the data in columns a-c and e-i to the necesary columns.