Sub ПарсерВебСсылокСЛиста()
'aequit 02.03.2020
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim s As String
    Dim lКоличествоСтрок As Long
    Dim i As Long, n As Long
    Set ws1 = Worksheets("Лист1")
    Set ws2 = Worksheets("Лист2")
    lКоличествоСтрок = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lКоличествоСтрок
        s = Get_Hyperlink_Address(Cells(i, 1))
        If Left(s, 4) = "http" Then
            n = n + 1
            ws2.Cells(n, 1) = s
        End If
    Next i
End Sub

Function Get_Hyperlink_Address(ByVal rCell As Range) As String
'Автор - https://www.excel-vba.ru/chto-umeet-excel/kak-poluchit-adres-giperssylki-iz-yachejki/
    Dim s As String
    If rCell.Hyperlinks.Count = 0 Then
        If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then
            Get_Hyperlink_Address = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13)
        Else
            Get_Hyperlink_Address = "В ячейке нет гиперссылки!"
        End If
    Else
        s = rCell.Hyperlinks(1).SubAddress
        If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress
        Get_Hyperlink_Address = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s
    End If
End Function

Sub ПарсерВебСсылокСЛиста()
'aequit 02.03.2020 v.2
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim s As String
    Dim lКоличествоСтрок As Long
    Dim i As Long, n As Long
    Set ws1 = Worksheets("Лист1")
    Set ws2 = Worksheets("Лист2")
    lКоличествоСтрок = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lКоличествоСтрок
        s = Get_Hyperlink_Address(ws1.Cells(i, 1))
        If Left(s, 4) = "http" Or Left((ws1.Cells(i, 1)), 4) = "http" Or Left((ws1.Cells(i, 1)), 3) = "www" Then
            n = n + 1
            If Left(s, 4) <> "В яч" Then
                ws2.Cells(n, 1) = s
            Else
                ws2.Cells(n, 1) = ws1.Cells(i, 1)
            End If
        End If
    Next i
End Sub