Macro excel 2003

Bonjour j'aurais besoin d'un petit coup de pouce
J'ai une macro qui permet de découper un classeur excel en plusieurs différents classeurs excel en fonction des départements et des services et de les enregistrer sur le bureaux.
J'aurais aimer savoir comment changer ma macro pour pouvoir choisir le nom des fichiers à enregistrer sur le bureaux pour qu'il corresponde aux noms des département.
Merci d'avance
Voiçi la macro :
Option Explicit

Sub test()

Dim newWbk As Workbook
Dim dossierSauvegarde As String, colonneDepartement As String
Dim i As Long, ligneDebutCopie As Long, ligneFinCopie As Long

'dossier où seraont créés les fichiers (à la racine du classeur dans l'exemple)
dossierSauvegarde = ThisWorkbook.Path

colonneDepartement = "A"

With ThisWorkbook.Sheets("Feuil1")
'trier les données de la feuille par département
.Range(.Range("A2"), .Range("A2").End(xlToRight).End(xlDown)).Sort Key1:=.Range(colonneDepartement & "2"), Order1:=xlAscending

'boucler sur chaque entrée
For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
'récupérer la ligne de la première valeur du "département traité"
ligneDebutCopie = i
'tant que la ligne suivant concerne le département traité
While .Range(colonneDepartement & i).Text = .Range(colonneDepartement & i + 1).Text
'incrémenter i (passer à la ligne suivante)
i = i + 1
Wend
'récupérer la ligne de la dernière valeur du "département traité"
ligneFinCopie = i

'créer un nouveau classeur avec une seule feuille
Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)

'copier la ligne de titre
.Rows(1).Copy newWbk.Sheets(1).Range("A1")

'copier les valeurs du "département traité"
.Rows(ligneDebutCopie & ":" & ligneFinCopie).Copy newWbk.Sheets(1).Range("A2")

'sauver le nouveau classeur
newWbk.SaveAs dossierSauvegarde & "\" & .Range(colonneDepartement & i).Text

'fermer le nouveau classeur
newWbk.Close True
Next i
End With
End Sub