Vba excel Challenge, Aller cherché des liens

Sub ouvre_liens()
Dim sel As Hyperlink
For Each sel In ActiveSheet.Columns(4).Hyperlinks
    sel.Follow NewWindow:=False, AddHistory:=True
Next sel
End Sub

Sub valide_lien() ' validation liens d'une colonne
Dim lig As Long
Dim col As Integer
col = 4             ' numéro colonne à valider (D ?)
For lig = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
    If left(Cells(lig, col).Value,4) = "http" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(lig, col), _
            Address:=Cells(lig, col).Value, TextToDisplay:=Cells(lig, col).Value
    End If
Next lig
End Sub

Sub affiche_liens()
'
' affiche_liens Macro
' affiche liens
'


    Application.Goto Reference:="affiche_liens"
    
    Range("A2").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.member.php?login=r&password=" _
        , Destination:=Range("$A$2"))
        .Name = "member.php?login=&password="
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "1"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False '
        .Refresh BackgroundQuery:=False
    End With
    
    ActiveWorkbook.Save
    Application.Run "essai.xlsm!affiche_liens"
    Columns("A:A").Select
    Selection.ColumnWidth = 20
    Columns("A:A").Select
    Selection.ColumnWidth = 4.86
    Selection.ColumnWidth = 5.57
    Range("B3").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("C3").Select
    Selection.ClearContents
    Range("B3").Select
    ActiveWorkbook.Save

    Application.Run "essai.xlsm!affiche_liens"  ' ya pas des trucs en trop ici ?
    ActiveWorkbook.Save                                  '
    Application.Run "essai.xlsm!affiche_liens"      '

End Sub




Sub valide_lien() ' validation liens d'une colonne
Dim lig As Long
Dim col As Integer
col = 2             ' numéro colonne à valider (D ?)
For lig = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
    If Left(Cells(lig, col).Value, 4) = "http" Then      'faut t'il que je remplace le 4 par 2 ici aussi ?
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(lig, col), _
            Address:=Cells(lig, col).Value, TextToDisplay:=Cells(lig, col).Value
    End If
Next lig
End Sub




Sub ouvre_liens()
Dim sel As Hyperlink
For Each sel In ActiveSheet.Columns(2).Hyperlinks
    sel.Follow NewWindow:=False, AddHistory:=True
Next sel
End Sub