Duplicate Row and Edit Values Within Table

[migos]

Hi I currently track sales activities that are sometimes performed by more than one sales person. As you can see in the attached the Sales Person (Column B) will occasionally have a "/" to define the multiple persons involved.
Issue: The code I have so far places the duplicated row directly beneath the original row (See Screenshots), and since my data is formatted as a Table, I receive Error 1004. Could someone advise as how to changing the code to placing the duplicate row(s) beneath the entire table. Or alternatively, another solution to get around the Error 1004.

Thank you in advance!

Sub Procedure1()
 Dim S As String, r As Long, Z, n As Long
    r = 4: Do Until Cells(r, 4) = "": S = Cells(r, 4): Z = Split(S, "/")
            If UBound(Z) Then
    Cells(r + 1, 1).Resize(UBound(Z), 20).Insert: Cells(r, 4) = Z(0)
    For n = 1 To UBound(Z): Cells(r + n, 1).Resize(1, 20).Value = _
    Cells(r, 1).Resize(1, 20).Value: Cells(r + n, 4).Value = Z(n)
    Next n: r = r + n
            Else: r = r + 1: End If: n = 0: Loop
End Sub

example.JPG

[Marc L]

Hi !

As least join a workbook attachment …