Bonjour,
Une petite optimisation de la procédure d'Optimix !?
Cdlt.
Sub Extraction2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim nL2 As Long, nC As Long, i As Long
Dim n
'Application.ScreenUpdating = False
Set ws1 = Sheets("Feuil1")
Set ws2 = Sheets("Feuil2")
nL2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
nC = ws1.Range("A1").CurrentRegion.Columns.Count
For i = 2 To nL2
On Error Resume Next
n = Application.Match(ws2.Cells(i, 1).Value, ws1.Columns(2), 0)
If Not IsError(n) Then
ws2.Cells(i, 2).Resize(, nC).Value = ws1.Cells(n, 1).Resize(, nC).Value
End If
Next i
ws2.Cells(1).EntireColumn.Delete
End Sub
Cdlt.