Sub Extrait()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set f = Sheets("V15")
'--- Liste des travées
For Each c In f.Range("AF11", f.[AF65000].End(xlUp)) ' pour chaque travée
On Error Resume Next
temp = CStr(c.Value)
Sheets(temp).Delete
On Error GoTo 0
Sheets("Tab. Type").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
'-- extraction
ligne = 6
For I = 11 To f.[AD65000].End(xlUp).Row
If CStr(f.Cells(I, "AD")) = temp Then
Cells(ligne, "A") = f.Cells(I, "AD")
Cells(ligne, "J") = f.Cells(I, "H")
Cells(ligne, "I") = f.Cells(I, "G")
ligne = ligne + 1
End If
Next I
Next c
End Sub