Fonction enregistrement separee

Bonjour tous!

J'ai une problématique avec un fichier excel, je explique:

J'ai un programme en VBA que a partir d'un export d'une basse de donnes, me fais une misse en forme des donnes dans des différentes feuilles de calcul, donc j'ai 21 feuilles appelées: 7501, 7502, 7503, 7504, 7505, 7601, 7602, 7603, 7604, 7701, 7703, 7704, 7705, 7801, 7802, 7803, 7804, 7901, 7903, 7904, 7905. Qui correspondent a des noms des secteurs.

Donc ce qu'il me faut c'est une fonction qui m'enregistre dans des fichier excel séparées chaque secteur, donc touts les secteurs 75 dans un fichier exel, les secteur 76 dans un autre fichier, ....etc jusqu'à le 79. ce qui me fais un total de 5 fichier a créer chacun avec un nom spécifique: "NOMETUDE_SUIVI CODE 6 mois_secteur 75_jj.mm.aaaa.xls".

Après j'ai un autre soucis les fichier seront enregistre dans arborescence suivante: \\serveur\partage\nom-étude\résultats. mais si c'est possible sa serait bien que le programme me crée un dossier avec la date du jour donc \\serveur\partage\nom-étude\résultats\20110503 et qui m'enregistre les fichier excel dedans

A savoir que le programme tourne touts les jours donc si tout sa pourrai se faire automatiquement sa serait super

Juste pour info la fonction se enregistrement que j'utilise c'est la suivante mais c'est que pour un seul résultat et la j'ai 5 et je pas reusi a l'adapter

Sub SaveAs()
    Application.DisplayAlerts = False

    'nom des fichiers sauvegarder'
    NomFichierXLS = "CHRONO_Etat_d'avancement_" & Format(Now, "yyyymmdd") & ".xls"

    nom_complet = ActiveWorkbook.Path

    'sauvegarde au format xls
    Sheets(Array("feuille1", "feuille2", "feuille3", "feuille4", "feuille5", "feuille6")).Select
    Sheets("feuille3").Activate
    Sheets(Array("feuille1", "feuille2", "feuille3", "feuille4", "feuille5", "feuille6")).Copy

    nom_complet = chemin_sauvegarde_xls & "\" & NomFichierXLS
    ActiveWorkbook.SaveAs Filename:= _
        nom_complet _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

    ActiveWindow.Close
    Application.DisplayAlerts = True

End Sub

Meci d'avance a touts et je m'excuse toujours pour mon orthographe je suis un colombien en France depuis pas longtemps. puis je suis disponible pour plus d'infos!

j'ai réussi a trouver la solution Merci quand même ! si qualqun autre est interese voila le code:

Sub subSplitAndRecord()
'utilise la bibliothèque "Windows Script Host Object Model"
Dim oWbk As Excel.Workbook, oSh As Excel.Worksheet
Dim oFso As IWshRuntimeLibrary.FileSystemObject
Dim sWbkFolderPath As String, sNewFolderName As String, sFileName As String
Dim vArea As Variant, sWorksheets As String

'relever le chemin du dossier contenant le classeur
sWbkFolderPath = ThisWorkbook.Path

'établir le nom du nouveau dossier
sNewFolderName = Format(Date, "yyyymmdd")

Set oFso = New IWshRuntimeLibrary.FileSystemObject
If oFso.FolderExists(sWbkFolderPath & "\" & sNewFolderName) Then oFso.DeleteFolder sWbkFolderPath & "\" & sNewFolderName, True
oFso.CreateFolder sWbkFolderPath & "\" & sNewFolderName

'parcourir les secteurs
For Each vArea In Array("75", "76", "77", "78", "79")
    sWorksheets = ""
    sFileName = "fichier_Etat_d'avancement_" & vArea & "." & Format(Date, "yyyymmdd") & ".xls"

    For Each oSh In ThisWorkbook.Worksheets
        If oSh.Name Like vArea & "*" Then sWorksheets = sWorksheets & "," & oSh.Name
    Next oSh

    If sWorksheets <> "" Then
        sWorksheets = Mid$(sWorksheets, 2)
        ThisWorkbook.Worksheets(Split(sWorksheets, ",")).Copy
        Set oWbk = ActiveWorkbook
        oWbk.SaveAs sWbkFolderPath & "\" & sNewFolderName & "\" & sFileName
        oWbk.Close
    End If

Next vArea

Set oWbk = Nothing
Set oFso = Nothing

End Sub