Option Explicit: Option Compare Text
Sub Secteurs()
If ActiveSheet.Name <> "Feuil1" Then Exit Sub
Dim m&, n1&: m = Rows.Count
n1 = Cells(m, 6).End(3).Row: If n1 = 1 Then Exit Sub
Dim T1, T2, S&(1 To 4), v$, n2&, k&, i&, j&
n2 = Cells(m, 7).End(3).Row: Application.ScreenUpdating = 0
If n2 > 1 Then [G2].Resize(n2 - 1).ClearContents
With Worksheets("Feuil2")
For i = 1 To 4
n2 = .Cells(m, i).End(3).Row
S(i) = n2: If n2 > k Then k = n2
Next i
If k = 1 Then Exit Sub
T2 = .[A1].Resize(k, 4)
End With
n1 = n1 - 1: T1 = [F2].Resize(n1, 2)
For i = 1 To n1
v = Trim$(Replace$(T1(i, 1), Chr$(160), " "))
If v <> "" Then
For k = 1 To 4
For j = 2 To S(k)
If Trim$(Replace$(T2(j, k), Chr$(160), " ")) = v _
Then T1(i, 2) = T2(1, k): GoTo 1
Next j
Next k
End If
1 Next i
[G2].Resize(n1) = Application.Index(T1, _
Evaluate("Row(" & "1:" & n1 & ")"), 2)
End Sub