More efficient way to loop through lines and duplicate if a certain character is found

I have around 3K rows of data imported from Microsoft Planner.

In the column "Assigned to", there are lines that contain strings like: "Employee A; Employee B; Employee C".
I want to find these lines and duplicate them so that they become (in this example) three lines: "Employee A" "Employee B" "Employee C".
The content of every other column is duplicated.

What I came up takes around 2-3 minutes to complete. There are approximately 3K rows at the start and I end up with 7K rows.

'=================================
'How many rows have multiple employees assigned?
'=================================
lNbLignes = tbl1lpEmploye.ListColumns("Nom du compartiment").DataBodyRange.End(xlDown).Row 'Total number of rows
iColonne = tbl1lpEmploye.ListColumns("Assigned to").DataBodyRange.Column 'Column that contains the assignments

iCompteur = 0
'Count the number of rows that contain ";" in "Assigned to" and thus need to be duplicated
For I = 2 To lNbLignes
    If InStr(ws1lpEmploye.Cells(I, iColonne).Value, ";") <> 0 Then
        iCompteur = iCompteur + (Len(ws1lpEmploye.Cells(I, iColonne).Value) - Len(Replace(ws1lpEmploye.Cells(I, iColonne).Value, ";", "")))
    End If
Next I

'=================================
'Duplicate rows with multiples assignments
'=================================
iColonne = tbl1lpEmploye.ListColumns("Assigned to").DataBodyRange.Column
    
For I = 2 To (lNbLignes + iCompteur) 'Number of rows + number of rows with ";" in "Assigned to"
    iPosition = InStr(ws1lpEmploye.Cells(I, iColonne).Value, ";") '"Employee A; Employee B; Employee C"
    If iPosition <> 0 Then
        With ws1lpEmploye
            .Rows(I + 1).Insert 'Add a news row
            .Cells(I + 1, iColonne).Value2 = Mid(.Cells(I, iColonne).Value2, iPosition + 1) 'Add the name following the character ";" in the new row I+1
            .Cells(I, iColonne).Value2 = Left(.Cells(I, iColonne).Value2, iPosition - 1) 'Keep the previous name in row I
            'At this point, RowI: "Employee A"
            'Row I+1: "Employee B;Employee C". The loop will continue at I+1, so the next lines that will be looked at is this one
            For j = 1 To tbl1lpEmploye.ListColumns.Count 'Copy the content of every other column in I+1
                Select Case j
                    Case iColonne
                        'Don't do anything to the "Assigned to" column
                    Case Else
                        .Cells(I + 1, j).Value2 = .Cells(I, j).Value2 '
                End Select
             Next j
        End With
    End If
Next I

Is there a way to do this in an array and then transfer the results to the original Excel table, that would be quicker?

• Reading and writing cells on a worksheet can be time-consuming. A more efficient approach is to load the data into an array.

Microsoft documentation:

Range.Resize property (Excel)

Split function

ListObject.DataBodyRange property (Excel)

    Set tbl1lpEmploye = Sheet1.ListObjects(1) ' for testing
    '=================================
    'How many rows have multiple employees assigned?
    '=================================
    iColonne = tbl1lpEmploye.ListColumns("Assigned to").Index 'Column index that contains the assignments
    
    Dim arrData, arrRes, iC As Long, ColCnt As Long, aStr, vStr
    ' load table into an array
    arrData = tbl1lpEmploye.DataBodyRange.Value
    ColCnt = UBound(arrData, 2)
    iCompteur = 0
    'Count the number of rows in output
    For I = 1 To UBound(arrData)
        iCompteur = iCompteur + UBound(Split(arrData(I, iColonne), ";")) + 1
    Next I
    ReDim arrRes(1 To iCompteur, 1 To ColCnt)
    
    '=================================
    'Duplicate rows with multiples assignments
    '=================================
    iCompteur = 0
    ' loop through table rows
    For I = 1 To UBound(arrData)
        ' split "Assigned to"
        aStr = Split(arrData(I, iColonne), ";")
        ' dubplicate rwos
        For Each vStr In aStr
            iCompteur = iCompteur + 1
            For iC = 1 To ColCnt
                If iC = iColonne Then
                    arrRes(iCompteur, iC) = vStr
                Else
                    arrRes(iCompteur, iC) = arrData(I, iC)
                End If
            Next iC
        Next
    Next I
    ' write output to sheet
    tbl1lpEmploye.DataBodyRange.Cells(1).Resize(iCompteur, ColCnt).Value = arrRes