Sub ZoneTexteClic()
Dim tableau As Range, lig As Long, i As Byte, col As Byte, plage As Range
Dim h As Byte, tablo, MAIL As Range, TELAM As Range, TELPM As Range
Dim AUTRE As Range, j As Byte
'---préparation---
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set tableau = Evaluate(ThisWorkbook.Names(Application.Caller).RefersTo)
lig = Application.Match(Replace(Application.Caller, "_", " "), [A:A], 0) + 3
Rows(lig + 1).Resize(tableau.Rows.Count).ClearContents 'RAZ
'---remplissage du tableau---
For i = 1 To Application.Count(Rows(lig))
col = Application.Match(Cells(lig, i), tableau.Rows(-1), 0)
Set plage = tableau.Columns(col)
h = Application.CountIf(plage, "><")
tablo = Application.Transpose(plage.Resize(h))
Set plage = Cells(lig + 1, i).Resize(h)
Set MAIL = Cells(lig + 1, 1).Resize(, i)
Set TELAM = Cells(lig + 2, 1).Resize(3, i)
Set TELPM = Cells(lig + 5, 1).Resize(3, i)
Set AUTRE = Cells(lig + 8, 1).Resize(, i)
For j = 1 To h
Select Case j
Case 1: Cells(lig + j, i) = ChercheNom(tablo, plage, MAIL)
Case Is < 5: Cells(lig + j, i) = ChercheNom(tablo, plage, TELAM)
Case Is < 8: Cells(lig + j, i) = ChercheNom(tablo, plage, TELPM)
Case 8: Cells(lig + j, i) = ChercheNom(tablo, plage, AUTRE)
Case Else: Cells(lig + j, i) = ChercheNom(tablo, plage)
End Select
Next
Next
Application.Calculation = xlCalculationAutomatic
End Sub
Function ChercheNom(tablo, plage As Range, Optional zone As Range)
Dim pos As Byte, i As Byte, r As Range
pos = 32
For i = 1 To UBound(tablo)
If Application.CountIf(plage, tablo(i)) = 0 Then
If zone Is Nothing Then ChercheNom = tablo(i): Exit Function
'nom LE PLUS ANCIEN dans zone
Set r = zone.Find(tablo(i), , xlValues, xlWhole, xlByColumns, xlPrevious)
If r Is Nothing Then ChercheNom = tablo(i): Exit Function
If r.Column < pos Then pos = r.Column: ChercheNom = tablo(i)
End If
Next
End Function