Multiple rows from a single record?

Originally Posted by stnkynts

Sub RunMe()
'// While not impossible to manipulate data in place, it is much easier and less time consuming for me to output to a new sheet
'// Create a temporary sheet, in this scenario called tempSheet, so that the code can split your data.  You can copy and paste back to other sheet over old data if you wish.
Dim ws1 As Worksheet:   Set ws1 = Sheets("Sheet1") 'source sheet
Dim ws2 As Worksheet
Dim LR As Long
Dim vSplit As Variant
Dim rCell As Range
Dim i As Integer

'// In case your forgot
If Not Evaluate("=ISREF('tempSheet'!A1)") Then
    MsgBox ("Make the tempSheet")
    Exit Sub
End If

Application.ScreenUpdating = False

'// Main Code
Set ws2 = Sheets("tempSheet") 'output sheet
ws1.Rows(1).Copy
ws2.Rows(1).PasteSpecial xlPasteColumnWidths
ws2.Rows(1).PasteSpecial xlPasteAll

LR = ws1.Range("D" & Rows.Count).End(xlUp).Row

For Each rCell In ws1.Range("D2:D" & LR)
    If Not Len(rCell) = 0 Then
        If Not InStr(1, rCell, ";") = 0 Then
            vSplit = Split(rCell, ";")
            For i = LBound(vSplit) To UBound(vSplit)
                rCell.EntireRow.Copy ws2.Range("D" & Rows.Count).End(xlUp).Offset(1, -3)
                ws2.Range("D" & Rows.Count).End(xlUp) = Trim(vSplit(i))
            Next i
        End If
    End If
Next rCell

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Hi stnkynts,

Thanks a lot for the reply. I did open the excel worksheet and went to the developer tab and click Visual Basic. It opened a new window where in the General window I pasted the codes you provided and Run them. It asks for "Make the tempSheet" where I pressed "OK". But it doesn't do anything? Am I doing something wrong here? Sorry I am a total novice here Thanks once more for your help mate.

Hi stnkynts,

Sorry for the earlier post. Its my bad...the script is working perfectly now. Please disregard my previous reply. You are a saviour mate. Cheers and thanks once again.