Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Object
Dim foundCell As Variant
Dim chaine, returnValue, rempl As String
Dim total, cpt As Long
Application.EnableEvents = False
'test sur la cellule cible
If Not Intersect(Target, Range("Nomination_Pers")) Is Nothing Then
chaine = Cells(Target.Row, "H").Value
rempl = Cells(Target.Row, "I").Value
Else
Exit Sub
End If
If Len(chaine) = 0 Then Exit Sub
'debut de la recherche
For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
total = total + Application.CountIf(ws.UsedRange, "=" & chaine)
Next ws
'total = total - 1
If total = 0 Then
MsgBox "Pas d'entrée correspondant à cette personne", vbOKOnly, "Message"
Else
cpt = 0
For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
With ws
.Activate
Set foundCell = .Cells.Find(What:=chaine, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
Do
cpt = cpt + 1
foundCell.Activate
Select Case total
Case Is = 1
MsgBox "Il existe une seule entrée correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlWhole
MsgBox "Cette entrée a été remplacée par : " & rempl, vbOKOnly, "Message"
copier_coller
Exit For
Case Is = cpt
MsgBox "Dernière entrée correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlWhole
MsgBox "Fin des modifications pour : " & chaine, vbOKOnly, "Message"
copier_coller
Exit For
Case Else
MsgBox "Entrée n° " & cpt & " correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlWhole
returnValue = MsgBox("Cette entrée a été remplacée par : " & rempl & vbLf & "Voulez-vous continuer les modifications ?", vbYesNo, "Message")
If returnValue = vbNo Then
Sheets("Personnes").Activate
Target.Select
Exit Sub
Else
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
End Select
Loop Until foundCell Is Nothing
End If
End With
Next ws
End If
Sheets("Personnes").Activate
Target.Select
Application.EnableEvents = True
End Sub
Sub copier_coller()
Sheets("Personnes").Activate
Range("I3:I65536").Select
Selection.Copy
Range("H3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub