Excel VBA vlookup with multiple results

Option Explicit

Sub SplitEmails()
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim emails() As String

On Error GoTo Err_SplitEmails

    Set srcWsh = ThisWorkbook.Worksheets(1) 'replace 1 with corresponding sheet name, for ex.: ThisWorkbook.Worksheets("ReportQuery")
    Set dstWsh = ThisWorkbook.Worksheets(2) 'replace 2 with corresponding sheet name, for ex.: ThisWorkbook.Worksheets("FinalData")

    With dstWsh
        .Range("A1") = "Report"
        .Range("B1") = "Email"
        .Range("A1:B1").Font.Bold = True
        .Range("A1:B1").Interior.Color = vbGreen
        .Range("A1:B1").Borders.LineStyle = xlContinuous
    End With

    i = 2
    k = 2
       
    Do While srcWsh.Range("A" & i) <> ""
        emails = Split(CStr(srcWsh.Range("B" & i)), ",")
        For j = LBound(emails()) To UBound(emails())
            With dstWsh
                .Range("A" & k + j) = srcWsh.Range("A" & i)
                .Range("B" & k + j) = Trim(emails(j))
                .Range("A" & k + j & ":B" & k + j).Borders.LineStyle = xlContinuous
            End With
        Next
        k = k + j
        i = i + 1
    Loop


Exit_SplitEmails:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    
    Exit Sub

Err_SplitEmails:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SplitEmails

End Sub