Sub testtt()
Range(Cells(ActiveCell.Row, "d"), Cells(ActiveCell.Row, "u")).Select
Selection.Copy
Sheets("FICHE").Select
Range("S9").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Répertoire As String, FichierASauvegarder As String
Répertoire = Range("S28")
'Création d'un nouveau classeur et première sauvegarde
ActiveSheet.Copy
ActiveSheet.Name = Sheets("FICHE").Range("S26")
FichierASauvegarder = ActiveSheet.Name & ".xls"
ActiveWorkbook.SaveAs Répertoire & FichierASauvegarder
ActiveWindow.Close
Sheets("DIRECTION").Select
Cells(ActiveCell.Row, "E").Select
End Sub