Copy phone number and email from table from list of urls

Option Explicit

Sub CopySsciComData()
Dim srcWbk As Workbook
Dim lstWsh As Worksheet, srcWsh As Worksheet, dstWsh As Worksheet
Dim i As Integer, sAddress As String

On Error GoTo Err_CopySsciComData

'destination sheet
Set dstWsh = ThisWorkbook.Worksheets(2)
dstWsh.Range("A1") = "Contact Person"
dstWsh.Range("B1") = "Phone"
dstWsh.Range("C1") = "Mobile"
dstWsh.Range("D1") = "Email"
dstWsh.Range("A1:D1").Font.Bold = True

'sheet where links are stored
Set lstWsh = ThisWorkbook.Worksheets(1)
i = 2 'links started in second row
'loop through the collection of links
Do While lstWsh.Range("A" & i) <> ""
    'get address
    sAddress = lstWsh.Range("A" & i)
    'open worbook from link
    Set srcWbk = Workbooks.Open(Filename:=sAddress, ReadOnly:=True, AddToMru:=False)
    'get data
    Set srcWsh = srcWbk.Worksheets(1)
    srcWsh.Range("B5").Copy dstWsh.Range("A" & i)
    srcWsh.Range("B9").Copy dstWsh.Range("B" & i)
    srcWsh.Range("B10").Copy dstWsh.Range("C" & i)
    srcWsh.Range("B12").Copy dstWsh.Range("D" & i)
    Set srcWsh = Nothing
    srcWbk.Close SaveChanges:=False
    Set srcWbk = Nothing
    i = i + 1
Loop

Exit_CopySsciComData:
    'ignore errors
    On Error Resume Next
    If Not srcWbk Is Nothing Then srcWbk.Close SaveChanges:=False
    Set srcWbk = Nothing
    Set srcWsh = Nothing
    Set lstWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

Err_CopySsciComData:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CopySsciComData
End Sub