Sub tata()
Dim i&, j&, tmp$, a(), b()
P1: With Feuil2.Range("A1")
b = .Parent.Range(.Offset(0, 2).Cells, .Parent.Cells(.Parent.Rows.Count, .Offset(0, 2).Column).End(xlUp).Offset(1)).Value
End With
b(UBound(b), 1) = " "
P2: With Feuil1.Range("B5")
a = .Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)).Value
End With
ReDim Preserve a(1 To UBound(a), 1 To 2)
For i = 2 To UBound(a)
tmp = UCase(WorksheetFunction.Trim(a(i, 1)))
For j = 1 To UBound(b)
If InStr(1, tmp, UCase(b(j, 1))) Then
a(i, 2) = Right$(tmp, Len(tmp) - Len(b(j, 1))) & " (" & UCase(Trim(b(j, 1))) & ")"
Exit For
End If
Next
Next
P3: With Feuil1.Range("AI5")
.Resize(UBound(a), 2).Value = a
End With
End Sub
Sub toto()
Dim i&, j&, k&, tmp$, a(), b()
P1: With Feuil2.Range("A1")
a = .Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp)).Value
With .Offset(0, 1)
b = .Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Offset(1)).Value
End With
b(UBound(b), 1) = " "
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
With .Offset(0, 2)
.Parent.Columns(.Column).Resize(.Parent.Rows.Count - .Row + 1, 1).Offset(.Row - 1).ClearContents
For i = 1 To UBound(a)
tmp = a(i, 1)
For j = 1 To UBound(b)
.Offset(k).Value = tmp & b(j, 1)
k = k + 1
Next
Next
End With
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End With
End Sub