Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$, dos$
For Each h In ActiveSheet.Columns("I").Hyperlinks
ad = h.Address
txt = h.Parent.Offset(, -8) & "\"
If txt Like "Test*" Then
If InStr(ad, "AncienDossier") Then _
ad = Replace(ad, "AncienDossier", "Test") Else Coul h.Parent: GoTo 1
If InStr(ad, "Demos\") Then _
ad = Replace(ad, "Demos\", txt) Else Coul h.Parent: GoTo 1
ElseIf txt Like "Docu*" Then
If InStr(ad, "AncienDossier") Then _
ad = Replace(ad, "AncienDossier", "Docu") Else Coul h.Parent: GoTo 1
If InStr(ad, "Doc\") Then _
ad = Replace(ad, "Doc\", txt) Else Coul h.Parent: GoTo 1
ElseIf txt Like "CAZ*" Then
If InStr(ad, "AncienDossier") Then _
ad = Replace(ad, "AncienDossier", "CAZ") Else Coul h.Parent: GoTo 1
dos = Mid(ad, 5, InStrRev(ad, "\") - 4) '5 = Len("CAZ") + 2
ad = Replace(ad, dos, txt)
End If
h.Parent.Hyperlinks.Add h.Parent, ad
1 Next
End Sub
Sub Coul(cel As Range)
cel.Interior.ColorIndex = 6 'couleur jaune
End Sub