Exporter groupe onglets dans autre fichier

Bonjour,

Hier la communauté m'a crée 2 codes VBA qui fonctionnent à merveilles

Sauf qu'en les mettant en pratique aujourd'hui, je me dis que ce serait plus faciles pour moi de regrouper les 3 onglets (fiche, Calcul, Barème) pour chaque nom dans un fichier. Mais une fois les créations faites, j'enregistrerai et c'est là où j'aimerais un nouveau code qui exporterait mon groupe d'onglets dans des fichiers aux noms qui figure dans l'onglet

je vous joint le fichier (avec les onglets crées)

Bonjour,

Cette petite adaptation du code vous crée 1 classeur par nom dans la colonne A de la feuille système. Pensez à adapter l'adresse dans le code si vous avez + de lignes.

Sub BoutonLRD()
  Dim LeNom, Ok As Boolean, NomFeuilleSource

  Application.ScreenUpdating = False
  NomFeuilleSource = Array("Fiche", "Calcul", "Bareme")
  ' ADAPTEZ LA LIGNE DE CODE CI DESSOUS
  LeNom = ActiveSheet.Range("A1:A2").Value2
  ' on lance une boucle ind�termin�e
  For i = 1 To UBound(LeNom)
    ' une boucle sur les noms
    ' ajout d'un classeur
    With Application.Workbooks.Add
      For j = 0 To 2
        ' on rend la main � l'application
        DoEvents
        ' on cr� la feuille
        ThisWorkbook.Worksheets(NomFeuilleSource(j)).Copy after:=.Worksheets(.Worksheets.Count)
        ActiveSheet.Name = j + 1 & "_" & LeNom(i, 1) & "_" & NomFeuilleSource(j)
      Next j
      ' suppression de la feuille initiale du classeur
      Application.DisplayAlerts = False
      .Worksheets(1).Delete
      Application.DisplayAlerts = True
    End With
    ' on boucle tant que OK est �gale � FAUX
  Next i
End Sub

Bonjour et merci

ce code crée bien des feuilles dans un nouveau classeur, mais ne reprends pas les importations des données de la "synthèse" (qui doivent être en lignes illimitées)

vers "la fiche", ni renommer les onglets avec le nom et prénom

De plus sans vouloir abuser si les classeurs peuvent avoir le nom des feuilles ça serait super

Pas compris votre histoire de lignes illimitées de la "synthèse" ?? Quelle synthèse ? Désolé. Je vous laisse voir avec @LooReeD s'il passe par là.

J'ai juste déplacé les feuilles que crée sa macro dans un nouveau classeur.

La macro renomme les onglets dans les nouveaux classeurs chez moi.

Pour les classeurs créés, ils ont besoin d'être enregistrés pour être renommés. Donc de savoir où vous voulez les sauvegarder. Si c'est le même dossier que le classeur de base ça va, sinon il faut me le préciser.

Re,

Désolée je ne vous avais pas joints le dernier fichier avec toutes les demandes

dans celui que je vous ai envoyé il y a dans l'onglet "Synthèse" les nom, prenom, date de naiss je peux avoir jusqu'à 200 noms dans les colonnes

c'est ça que j'appelle illimité

et également a été ajouté au VBA de Loureed le report des ,noms, prénoms, et date de naissance dans la fiche

en fait je ne sais pas où je dois ajouter votre vba dans celui-ci, désolée si je ne suis claire mais c'est complexe pour moi

Sub Creation_Feuille()

Dim f1 As Worksheet

Dim LeNom As String, LePrenom As String

Dim NomFeuilleSource As Variant

Dim NeLe As Date

Dim i As Long, j As Long, DerLig_f As Long

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set f1 = Sheets("Système")

Derlig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la feuille "Système"

If Derlig_f1 > 1 Then

NomFeuilleSource = Array("Fiche", "Calcul", "Bareme")

'on lance une boucle indéterminée

For i = 2 To Derlig_f1

'on récupère le nom voulu de la futur feuille qui se trouve en cellule A1

LeNom = f1.Cells(i, "A")

LePrenom = f1.Cells(i, "B")

NeLe = f1.Cells(i, "C")

'une boucle de trois pour les trois feuilles

For j = 0 To 2

'on rend la main à l'application

DoEvents

'on crée la feuille

On Error Resume Next

Worksheets(NomFeuilleSource(j)).Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = j + 1 & "_" & LeNom & "_" & NomFeuilleSource(j)

If Err.Number = 0 Then

If j = 0 Then

Cells(14, "B") = LeNom

Cells(18, "B") = LePrenom

Cells(20, "B") = NeLe

End If

Else

ActiveSheet.Delete

End If

Next j

Next i

End If

Sortie:

Set f1 = Nothing

End Sub