Sub reportb()
'debut = Timer
Dim n As Long
Dim res()
ReDim res(4, 0)
Set d = CreateObject("scripting.dictionary")
For n = 2 To Sheets("Feuil1").Range("A" & Application.Rows.Count).End(xlUp).Row
x = Sheets("Feuil1").Range("A" & n) & ";" & Sheets("Feuil1").Range("B" & n) & ";" & Sheets("Feuil1").Range("C" & n)
d(x) = x
Next n
a = d.keys
tablo = Sheets("Mapping").Range("A2:C" & Sheets("Mapping").Range("A" & Application.Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
Sheets("Feuil2").Range("A2:E" & Application.Rows.Count).ClearContents
For n = LBound(a) To UBound(a)
xx = Split(a(n), ";")(2)
For m = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(m, 1) = xx Then
res(0, UBound(res, 2)) = Split(a(n), ";")(0)
res(1, UBound(res, 2)) = Split(a(n), ";")(2)
res(2, UBound(res, 2)) = tablo(m, 2)
res(3, UBound(res, 2)) = ".1 Création"
res(4, UBound(res, 2)) = tablo(m, 3)
ReDim Preserve res(4, UBound(res, 2) + 1)
End If
Next m
Next n
Application.ScreenUpdating = True
Sheets("Feuil2").Select
Sheets("Feuil2").Range("A3").Resize(UBound(res, 2), 5) = Application.Transpose(res)
'MsgBox (Timer - debut)
End Sub