Sub Dispatche()
On Error GoTo Fin
Application.ScreenUpdating = False
Dim DL%, L%, F
DL = [A65500].End(xlUp).Row
For Each F In Worksheets
If F.Name <> "data" Then
With Sheets(F.Name)
.Range("A1:E10000").ClearContents
.Cells(1, 1) = F.Name: .Cells(1, 2) = "km": .Cells(1, 3) = "prix"
End With
End If
Next F
For L = 2 To DL
Feuille = Cells(L, "A")
If Feuille = "" Then Exit Sub
With Sheets(Feuille)
.Cells(.[C65500].End(xlUp).Row + 1, 2) = Cells(L, 3)
.Cells(.[C65500].End(xlUp).Row + 1, 3) = Cells(L, 5)
End With
Next L
Exit Sub
Fin:
MsgBox "La feuille " & Cells(L, "A") & " n'existe pas."
End Sub