Sub Extraction_90AA()
Const max = 15000
Dim derlig&, deb&, ncol&, n&, i&, j&, nfois, x, t, res(), T0
T0 = Timer
Application.ScreenUpdating = False
With Sheets("Feuil1")
If .FilterMode Then .ShowAllData
derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
deb = 1
Do
nfois = nfois + 1: t = .Cells(deb, "a").Resize(max)
ReDim res(1 To max, 1 To 1)
For i = 1 To UBound(t)
j = 1: n = 0: x = t(i, 1)
If x <> "" Then
Do
j = InStr(j, x, "90AA", vbTextCompare)
If j > 0 Then
n = n + 1
If n > UBound(res, 2) Then ReDim Preserve res(1 To UBound(res), 1 To UBound(res, 2) + 1)
res(i, n) = Mid(x, j, 14)
j = j + 10
Else
Exit Do
End If
Loop
End If
Next i
With Sheets("Extract")
If nfois = 1 Then .Range("a1").CurrentRegion.Clear
.Range("a1").Offset(max * (nfois - 1)).Resize(max, UBound(res, 2)) = res
.Range("a1").CurrentRegion.EntireColumn.AutoFit
End With
If max * nfois >= derlig Then Exit Do
Loop
End With
MsgBox "Durée: " & Format(Timer - T0, "0.00\ sec.")
End Sub