Sub CréerLien()
On Error Resume Next
For Each feuille In Sheets
If feuille.Name <> "Accueil" Then
NbLigne = Application.CountA(Columns(1))
For ligne = 2 To NbLigne
pays = feuille.Cells(ligne, 1)
capitale = feuille.Cells(ligne, 2)
feuille.Hyperlinks.Add Anchor:=feuille.Cells(ligne, 2), Address:="http://maps.google.fr/maps?q=" & capitale & "+" & pays & "&z=6", TextToDisplay:=capitale
Next ligne
End If
Next feuille
End Sub