Discussion :

[Oreo_]

Bonjour à tous,

Je dispose d'un fichier présenté de cette façon :
Code_etu ; Nom_etu ; matière
6 ; dupont ; maths
6 ; dupont ; français
6 ; dupont ; anglais
7 ; dupontel ; maths
7 ; dupontel ; physique
....
et je souhaite créer autant de fichier qu'il y a d'étudiants et à l'intérieur de ces fichiers, autant d'onglet que de matières.
Par exemple, un fichier excel "6 dupont.xls" avec 3 onglets (maths, français et anglais).

La création de fichiers fonctionne, voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub macro()
 
Dim rep As String, maquette As String, code_etu As String, nom_etu As String
Dim ligne As Integer, nbligne As Integer, nb_etu As Integer
 
donnees = "fichier test agri.xls"
nbligne = Workbooks(donnees).Worksheets("Feuil1").Range("A65536").End(xlUp).Row - 1
rep = "G:\documents\"
maquette = "maquette.xls"
 
Dim cellule As Range, celluledeux As Range, plage As Range
Dim adresse_cellule As String
Dim feuille_maquette As Worksheet
Set plage = Workbooks(donnees).Worksheets("Feuil1").Range("A2:A" & nbligne + 1)
Range("A2").Select
 
  For Each cellule In plage
    If cellule.Value <> "" Then
        If cellule.Value <> cellule.Offset(1, 0).Value Then
            code_etu = cellule.Value
            nom_etu = cellule.Offset(0, 1).Value
 
            'Sauvegarde du fichier etudiant
            Workbooks.Open Filename:=rep & maquette, UpdateLinks:=0
            Application.DisplayAlerts = False
            Workbooks(maquette).SaveAs Filename:=rep & "Livrables\" & code_etu & " " & nom_etu & ".xls", _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
 
            'Création des feuilles
            Range("C2").Select
            adresse_cellule = cellule.Offset(0, 2).Address
            For Each celluledeux In Workbooks(donnees).Worksheets("Feuil1").Range("C2:" & adresse_cellule)
                Set feuille_maquette = ActiveWorkbook.Worksheets("Feuil1")
                feuille_maquette.Copy Before:=Sheets("Feuil2")
                ActiveSheet.Name = celluledeux.Value
            Next celluledeux
        End If
    End If
  Next cellule
 
End Sub

La création des fichiers excel marche mais pas celle des feuilles... Cela marche seulement pour le premier étudiant, pour le 2ème, vba me créé autant d'onglets qu'il y a de ligne dans mon fichier excel de base. (or je voudrais seulement les onglets maths et physique)
Je n'arrive pas à résoudre mon problème...

Merci d'avance pour votre aide!

[COCONUT2]

Vba est géré par un ordi qui est tres basique.

Lorsque tu travailles sur plusieurs classeurs, il faut lui dire sur quel objet il doit travailler sinon, il fait des conneries!


Quand il doit travailler avec ton classeur de base, utilise Thisworkbook:

Thisworkbook.sheets(1).range("A1:B45")

par exemple

Apres l'ouverture du classeur maquette et son enregistrement,
stocke son nom dans une variable par exemple NouvEtud

et utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Workbook(NouvEtud).sheets.add

Ce qui te permet de toujours savoir sur quel classeur tu travaille!

[Oreo_]

Merci coconut.
Mais je pense que le soucis vient de la deuxième boucle For...

[Invité]

Bonsoir,
Est-il possible de nous fournir dans un fichier Excel quelques lignes du fichier de base ?

[Philippe Tulliez]

Bonjour,
Je pense que cela peut se résumer à une petite procédure qui parcourt le fichier où se trouve la liste des données qui appele la procédure de création de classeur et la procédure de création de feuille.
On suppose dans cet exemple que la liste commence en A1
Au préalable il faut trier la liste de données pour avoir dans l'ordre : Code, Nom, Matière
Le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Sub Test()
 Dim sht As Worksheet, rng As Range
 Dim Row As Long, wkName As String, shName As String
 Set sht = ThisWorkbook.Worksheets("Feuil1")
 Set rng = sht.Range("A1").CurrentRegion
 ' 
 ' Procédure Tri à placer ici 
 ' 
For Row = 2 To rng.Rows.Count
  If rng.Cells(Row, 2) <> wkName Then
   wkName = rng.Cells(Row, 2): CreaWorkBook wkName
  End If
  If rng.Cells(Row, 3) <> shName Then
   shName = rng.Cells(Row, 3): CreaWorkSheet shName
  End If
 Next
End Sub
Sub CreaWorkBook(Name As String)
 MsgBox "Creation classeur " & Name
End Sub
Sub CreaWorkSheet(Name As String)
 MsgBox "Creation feuille " & Name
End Sub

Donc à la place des msgbox, il faut placer les codes de création
A prévoir aussi une constante ou une variable contenant le chemin de répertoire où créer les classeurs

[EDIT]
On peut faire plus court en transformant les procédures Sub en Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Test()
 Dim sht As Worksheet, rng As Range
 Dim Row As Long, wkName As String, shName As String
 Set sht = ThisWorkbook.Worksheets("Feuil1")
 Set rng = sht.Range("A1").CurrentRegion
 ' Procédure Tri
 For Row = 2 To rng.Rows.Count
  If rng.Cells(Row, 2) <> wkName Then wkName = CreaWorkBook(rng.Cells(Row, 2))
  If rng.Cells(Row, 3) <> shName Then shName = CreaWorkSheet(rng.Cells(Row, 3))
 Next
End Sub
Function CreaWorkBook(Name As String) As String
 MsgBox "Creation classeur " & Name
 CreaWorkBook = Name
End Function
Function CreaWorkSheet(Name As String) As String
 MsgBox "Creation feuille " & Name
 CreaWorkSheet = Name
End Function

[Oreo_]

Bonjour,

Merci beaucoup Phillipe, ton code fonctionne, le seul soucis est que le nom du classeur devrait se composer du code de l'étudiant et de son nom "6 dupont.xls".
Aussi, j'aurais préféré que l'on adapte mon code (car j'ai l'impression de n'avoir rien fait du coup et que mes recherches n'ont servi à rien.. mais je comprend que ce soit pas évident de modifier un code déjà fait).

Que signifie "CurrentRegion"?

[Oreo_]

Bonsoir,
Est-il possible de nous fournir dans un fichier Excel quelques lignes du fichier de base ?

Bonjour,

En pièce jointes un échantillon du fichier.

Merci d'avance

[Philippe Tulliez]

Bonjour,

Bonjour,
Merci beaucoup Phillipe, ton code fonctionne, le seul soucis est que le nom du classeur devrait se composer du code de l'étudiant et de son nom "6 dupont.xls".
Aussi, j'aurais préféré que l'on adapte mon code (car j'ai l'impression de n'avoir rien fait du coup et que mes recherches n'ont servi à rien.. ).

Dans la solution que je propose, les procédures sont décomposées ce qui est plus simple pour la maintenance.
Une procédure parcourt le fichier où se trouve les informations, une autre est prévue pour créer un classeur et une autre pour créer une feuille.
La procédure pour créer un classeur qui est ici une fonction reçoit un argument qui est le nom à donner au classeur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Function CreaWorkBook(Name As String) As String
 MsgBox "Creation classeur " & Name
 CreaWorkBook = Name
End Function

Le code qui invoque cette fonction envoie le nom du classeur à créer
Donc il y a lieu de concaténer les valeurs de la colonne 1 & 2
Voici le code qui créer le classeur et les feuilles (il reste à créer le code qui supprime la feuille nommée Feuil1 de chaque classeur mais je te laisse le soin de le faire.
Il faut juste changer la valeur de la constante Folder
Ne pas oublier que la liste doit être triée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
Const Folder As String = "Z:\Tests\Creation\"
Dim wkName As String, shName As String
Sub Test()
 Dim sht As Worksheet, rng As Range, cName As String
 Dim Row As Long
 Set sht = ThisWorkbook.Worksheets("Feuil1")
 Set rng = sht.Range("A1").CurrentRegion
 ' Procédure Tri
 For Row = 2 To rng.Rows.Count
  With rng
   cName = .Cells(Row, 1) & .Cells(Row, 2)
   If cName <> wkName Then wkName = CreaWorkBook(cName)
   If rng.Cells(Row, 3) <> shName Then shName = CreaWorkSheet(rng.Cells(Row, 3))
  End With
  Next
 End Sub
Function CreaWorkBook(Name As String) As String
 'MsgBox "Creation classeur " & Name
 Application.DisplayAlerts = False
 If Len(wkName) Then ActiveWorkbook.Close savechanges:=True
 Application.DisplayAlerts = True
 Workbooks.Add (1)
 ActiveWorkbook.SaveAs Filename:=Folder & Name ' & ".xls"
 CreaWorkBook = Name
End Function
Function CreaWorkSheet(Name As String) As String
 With ActiveWorkbook
 .Worksheets.Add Before:=Sheets(1)
 .Worksheets(1).Name = Name
 End With
 ' MsgBox "Creation feuille [" & Name & "]" & " (" & wkName & ")"
 CreaWorkSheet = Name
End Function

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Dim Etudiants As Collection
Dim Matieres As Collection
Const rep = "G:\documents\"
Const maquette = "maquette.xls"
 
 
Private Sub matiere(V As String)
On Error Resume Next
    Matieres.Add V, "Name_" & V
On Error GoTo 0
End Sub
Private Sub Etudiant(cd As String, etu As String)
On Error Resume Next
    Etudiants.Add cd & " " & etu, "Name_" & cd & "_" & etu
On Error GoTo 0
End Sub
Sub scan()
Dim Myrange As Range
Dim L As Long
Set Etudiants = New Collection
Set Matieres = New Collection
Set Myrange = ActiveSheet.Range("A1").CurrentRegion
For L = 2 To Myrange.Rows.Count
    Etudiant Trim("" & Myrange(L, 1)), Trim("" & Myrange(L, 2))
    matiere Trim("" & Myrange(L, 3))
Next
For L = 1 To Etudiants.Count
    CreerClasseur Etudiants(L)
Next
End Sub
 
Private Sub CreerClasseur(Name)
Dim MyClasseur As Workbooks
Set MyClasseur = ActiveWorkbook.Application.Workbooks.Add(rep & maquette)
CreerFeuille MyClasseur
MyClasseur.SaveAs rep & "Livrables\" & Name
MyClasseur.Close False
End Sub
Private Sub CreerFeuille(Classeur As Workbook)
Dim M As Long
Dim feuille_maquette As Worksheet
Dim FeuilleNew As Worksheet
For M= 1 To Matieres.Count
    Classeur.Sheets(1).Select
    Set FeuilleNew = Classeur.Sheets.Add
    Set feuille_maquette = Classeur.Worksheets("Feuil1")
    feuille_maquette.Copy Before:=FeuilleNew 
    FeuilleNew.Name = Matieres(M)
Next
 
End Sub

[Oreo_]

Merci à vous deux pour votre aide précieuse!