Distancier

Sub test()
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument, D As String
Dim nbVil As Integer
Set IE = New InternetExplorer
    nbVil = Application.CountA(Range("A:A"))
    For t = 1 To nbVil
        For u = 1 To nbVil
            IE.navigate "http://fr.distance24.org/" & Cells(c.Row, 1) & "/" & Cells(1, c.Column)
            Do While IE.Busy Or IE.readyState = READYSTATE_LOADING: DoEvents: Loop
            Set Doc = IE.document
            D = Doc.body.innerText
            Cells(t + 1, u + 1) = Mid(D, InStr(D, " est de ") + 8, InStr(D, " kilomètres.") - InStr(D, " est de ") - 8)
        Next u
    Next t
Set IE = Nothing
End Sub

Option Explicit

Function Dst#(Lat1#, Lng1#, Lat2#, Lng2#)
'formule : [url=http://www.movable-type.co.uk/scripts/latlong.html]Calculate distance and bearing between two Latitude/Longitude points using Haversine formula in JavaScript[/url]
    Dim R As Long
    R = 6371
    Lat1 = Lat1 / 180 * WorksheetFunction.Pi()
    Lng1 = Lng1 / 180 * WorksheetFunction.Pi()
    Lat2 = Lat2 / 180 * WorksheetFunction.Pi()
    Lng2 = Lng2 / 180 * WorksheetFunction.Pi()
    If Lat1 = Lat2 And Lng1 = Lng2 Then
        Dst = 0
    Else
        Dst = Round(WorksheetFunction.ACos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Lng2 - Lng1)) * R, 3)
    End If
End Function

Sub Distancier()
Dim w1 As Worksheet, w2 As Worksheet, i&, j&, n&
    Application.ScreenUpdating = False
    Set w1 = Worksheets("Data"): Set w2 = Worksheets("Dst33")
    For i = 2 To w1.Cells(Rows.Count, 1).End(xlUp).Row
        n = n + 1
        w2.Cells(n + 1, 1) = w1.Cells(i, 1)
        w2.Cells(1, n + 1) = w1.Cells(i, 1)
    Next i
    For i = 2 To w2.Cells(Rows.Count, 1).End(xlUp).Row
        For j = 2 To w2.Cells(Rows.Count, 1).End(xlUp).Row
            If i = j Then
                w2.Cells(i, j) = 0
            Else
                w2.Cells(i, j) = Dst(w1.Cells(i, 3), w1.Cells(i, 4), w1.Cells(j, 3), w1.Cells(j, 4))
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub