Dim app$, n As Byte 'mémorise les variables
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
app = Application.Name
[10:250].Clear
Copier
End Sub
Private Sub Copier()
If n = 30 Then MsgBox "Copie impossible !": n = 0: Exit Sub 'sécurité
n = n + 1
SendKeys "{[COLOR="Red"]TAB 10[/COLOR]}^a^c" 'tabulations + sélectionne tout + copie
Application.OnTime Now + 1 / 86400, "Feuil1.Coller" 'essai chaque seconde
End Sub
Private Sub Coller()
Dim i As Integer, p As Boolean
[A10].Select
Application.ScreenUpdating = False
On Error Resume Next
Me.Paste
If Selection.Count = 1 Then Copier: Exit Sub 'en attente de l'ouverture effective
AppActivate app 'active Excel
Me.DrawingObjects.Delete 'supprime tous les objets
[A10].Select
For i = 250 To 10 Step -1
If Cells(i, 1) = "Perpignan" Then
p = True
Else
If p Or Application.CountIf(Rows(i).Resize(3), "*°*") = 0 Then Rows(i).Delete
End If
Next
Rows(11).Delete '[Edit] car il y a un lien hypertexte sur cette ligne...
n = 0
End Sub