Macro pour diviser des données d'une seule feuille vers plusieurs fichiers

Question

Petit casse-tête du jour pour moi... j'ai cherché sur internet mais je n'ai rien trouvé qui correspond à ce que je recherche. Pour faire simple, j'ai une extraction des heures par collaborateur. Le fichier se présente sous forme d'une seule feuille avec des vides entre chaque collaborateur. (toujours 6 lignes entre chaque tabluea, sauf le 1er tableau bien sûr qui commence directement sur la ligne 1) Mon souhait est de pouvoir lancer une macro qui, automatiquement, sépare les tableaux pour chaque collaborateur. J'ai joins un fichier anonymisé pour mieux comprendre. Une fois que chaque fichier est séparé (dans un dossier créé en amont), j'aimerais que ces fichiers soient envoyés automatiquement par mail au collaborateur concerné. (Feuil1 serait la table de correspondance du nom avec le mail) J'avais trouvé une macro sur internet que j'ai très très légèrement modifié compte tenu de mon faible niveau, mais je ne comprends pas bien comment changer le nom des fichiers (il me met 001,002...) et non le nom du collaborateur. Je joins cette macro test également. Le mieux, serait de pouvoir coller les données dans le classeur où la macro est située, et non de devoir l'activer avec 2 classeurs comme avec la macro exemple. Un grand merci pour votre aide et je reste à disposition pour des questions si cela n'est pas clair...

ThauThème · Accepted Answer

Bonsoir Angefelo, bonsoir le forum,

Le code ci-dessous vas enregistrer les classeur dans le même dossier que le classeur source :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim DL As Integer 'déclare la variable DL (Dernière ligne)
Dim LD As Integer 'déclare la variable LD (ligne Début)
Dim LF As Integer 'déclare la variable LF (ligne Fin)
Dim NP As String 'déclare la variable NP (Nom Prénom)

Application.ScreenUpdating = False 'masque le rafraîchissements d'écran
Set CS = ThisWorkbook 'définit la classeur Source CS
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
For I = 1 To DL 'boucle sur toutes les lignes I de 1 à DL
    LD = I 'définit la ligne de début LD
    'définit la ligne de fin LF (la ligne au-dessus du texte "Décompte CONFORMEH")
    LF = OS.Columns(1).Find("*Décompte CONFORMEH", OS.Cells(LD, "A"), xlValues, xlPart).Row - 1
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    'définit le nom prénom de l'employé (entre nous, quel est le *** qui tout écrit dans la même cellule)
    NP = Split(OS.Cells(LD + 2, "A").Value, ":")(2) 'génère une erreur s'il n'y a plus d'employé
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        MsgBox "Les classeurs ont été créés !" 'message
        Exit Sub 'sort de la procédure
    End If 'fin de la condition
    On Error GoTo 0
    Set CD = Workbooks.Add 'définir le classeur destination CD (en ajoutant un classeur vierge)
    Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
    OS.Rows(1).Copy 'copie la ligne 1 de l'onglet source
    OD.Rows(1).PasteSpecial 8 'colle la largeur des cellules dans l'onglet destination
    'copie la plage des lignes LD à LF et des colonne A à V et la colle dans A1 de l'onglet destination
    OS.Range(OS.Cells(LD, "A"), OS.Cells(LF, "V")).Copy OD.Range("A1")
    CD.SaveAs CA & NP, 51 'enregistre le classeur destination dans le même dossier que le classeur source avec le nom/prénom de l'employé comme nom du fichier
    CD.Close False 'ferme le classeur destination sans enregistrer
    I = LF 'rédéfinit I
Next I 'prochaine ligne de la boucle
End Sub