Discussion :

[roberto75]

Salut à toi,

J'aurai besoin de tes lumières pour créer une macro excel. Au commencement, j'ai un fichier excel de type .xls qui contient des données de plusieurs patients. Toutes les données sont contenues dans une seule et unique colonne ; la colonne A. Seul le nombre de ligne varie dans cette colonne A. Toute les 10 lignes on change de patient, des lignes A1 à A10 on a les données du patient 1, des lignes A11 à A20 on a les données du patient 2 ect.... Et la première cellule de chaque patient (A1,A11 ect....) contient le nom du patient.

On a un truc de ce genre dans notre fichier xls.

Pierre <-- A1
1
2
3
4
5
6
7
8
9
Paul <-- A11
12
54
24
58
24
26
25
8
55
Jack <-- A21
20
20
20
20
20
20
20
20
20
[case vide]

Ce que j'aimerai que ma macro fasse, c'est qu'elle crée un fichier excel normal, dans lequel elle importera toutes les valeurs des patients du fichier xls. de telle sorte qu'on ait dans ce nouveau fichier pour chaque patient, un onglet qui porte le nom du patient et qui contient ses données. On aurait donc ici 3 onglets, Pierre Paul et Jack qui contiennent leurs données respectives. Voilà !

Pouvez-vous me dire comment procéder ? Merci

A bientôt

[Theze]

Bonsoir,

Les valeurs de ta feuilles doivent toutes être comme dans ton exemple, teste :

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
 
Sub ClasseurPatients()
 
    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim FeAjout As Worksheet
    Dim Plage As Range
    Dim I As Integer
    Dim Tbl
 
    'adapter le nom de la feuille où se trouvent les valeurs
    Set Fe = ThisWorkbook.Worksheets("Feuil1")
 
    'crée le classeur
    Set Cls = Workbooks.Add
 
    'défini la plage pour la récupération des valeurs
    With Fe
        Set Plage = .Range(.[A1], .[A65536].End(xlUp))
    End With
 
    'passe la plage de 10 en 10
    For I = 1 To Plage.Count Step 10
 
        'ajoute une feuille au classeur
        Set FeAjout = Cls.Worksheets.Add
 
        'renomme la feuille au nom du patient
        FeAjout.Name = Plage(I)
 
        'utilise un tableau intermédiaire pour récupérer
        'les valeurs de chaque patient
        Tbl = Fe.Range(Plage(I + 1), Plage(I + 9))
 
        'puis les colle de A1 à A10
        FeAjout.[A1:A9] = Tbl
 
    Next I
 
End Sub

Hervé.

[roberto75]

Bonjour Hervé,

Merci pour ce code commenté, j'ai tout compris et ça marche du feu de Dieu.

J'aurai voulu savoir s'il était possible de créer les onglets dans un ordre précis c'est à dire l'onglet Pierre (A1) en première position en partant de la gauche ensuite l'onglet Paul(A11) ect.... /Pierre/Paul/Jack/ect...

Lorsqu'on créer le classeur 'Cls', est-ce qu'on peut supprimer automatiquement les feuilles vides (feuil1, feuil2, feuil3) qui sont toujours présentes lors de la génération dudit classeur.

Et dernière chose, peut-on donner un nom particulier au classeur "Cls" géneré, par exemple 'nomconstant DATEDUJOUR'

Merci pour ton aide,

@+

[mercatog]

1.

Code :

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

Set Cls = Workbooks.Add(1)

Nouveau classeur avec une seule feuille (attention, le 1 ne signifie pas le nombre de feuilles) Fais un F1 sur la méthode Add
2.

Code :

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

Set FeAjout = Cls.Worksheets.Add(After:=Cls.Worksheets(Cls.Worksheets.Count)

La nouvelle feuille crée est placée en dernier
3.

Code :

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

Set FeAjout = Cls.Worksheets(1).Delete

Permet de supprimer la Feuille 1 (la seule feuille vide qui a été créée avec la création du classeur Cls)
4.

Code :

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

1
2
Chemin="C:\Documents and Settings\Administrateur\Bureau\"'Ici mettre le chemin de ton dossier où enregistrer
Cls.SaveAs Chemin & "Toto " & Format(Date, "ddmmyyyy") &".xls"

Permet d'enregistrer Cls dans Chemin sous le nom Toto03032011.xls (exemple pour aujourd'hui)

[roberto75]

Bonjour et Merci Mercatog,

**Donc j'ai essayé de compléter le code avec tes contributions mais j'obtiens une petite erreur ligne 27 au niveau du Delete, on me dit que "les feuilles sélectionnées peuvent contenir des données. Pour supprimer définitivement les données, cliquez sur supprimer" Donc si je clique sur supprimer ou annuler et il me dit "Erreur d'exécution "429". Objet requis"

**Dans ma feuille initiale Fe, les données de chaque patient sont séparées par une case vide, est-il possible de supprimer ces cases vides au début de la macro ?
Pierre --> A1
1
2
3
4
5
6
7
8
9
[case vide] --> à supprimer
Paul --> A11
22
22
11
11
55
44
77
88
99
[case vide] --> à supprimer
ect...
Fin
[case vide]
[case vide]
[case vide]

**Concernant le chemin d'enregistrement du fichier Cls.xlsx, peut-on definir un chemin qui enregistre le fichier toujours sur le Bureau quelque soit le nom du disque dur 'Chemin= codegénérique "\Bureau\"' (on est sous windows)

**Dernière question, lorsque la macro génère les différents onglets, elle sélectionne systématiquement le dernier onglet crée. Peut-on faire en sorte qu'elle active toujours le premier onglet crée, l'onglet Pierre dans notre exemple.

Encore merci à vous,

A plus tard !

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
 
 
Sub ClasseurPatients()
 
   Dim Cls As Workbook
   Dim Fe As Worksheet
   Dim FeAjout As Worksheet
   Dim Plage As Range
   Dim I As Integer
   Dim Tbl
 
   'adapter le nom de la feuille où se trouvent les valeurs
   Set Fe = ThisWorkbook.Worksheets("Feuil1")
 
   'crée le classeur avec une seule feuille
   Set Cls = Workbooks.Add(1)
 
   'défini la plage pour la récupération des valeurs
   With Fe
       Set Plage = .Range(.[A1], .[A65536].End(xlUp))
   End With
 
   'passe la plage de 10 en 10
   For I = 1 To Plage.Count Step 10
 
       'ajoute une feuille au classeur en dernière position
       Set FeAjout = Cls.Worksheets.Add(After:=Cls.Worksheets(Cls.Worksheets Count)
        'On supprime la Feuil1
        Set FeAjout = Cls.Worksheets(1).Delete
 
       'renomme la feuille au nom du patient
       FeAjout.Name = Plage(I)
 
       'utilise un tableau intermédiaire pour récupérer
       'les valeurs de chaque patient
       Tbl = Fe.Range(Plage(I + 1), Plage(I + 9))
 
       'puis les colle de A1 à A10
       FeAjout.[A1:A9] = Tbl
 
    Next I
 
       'On enregistre Cls dans Chemin sous ce format NomDDMMAAAA
       Chemin="C:\Users\87\Desktop\"
       Cls.SaveAs Chemin & "Toto" & Format(Date, "ddmmyyyy") &".xlsx"
 
End Sub

[mercatog]

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
Sub ClasseurPatients()
Dim Cls As Workbook
Dim Fe As Worksheet, FeAjout As Worksheet
Dim Plage As Range
Dim i As Integer
Dim Chemin As String
 
Application.ScreenUpdating = False
'adapter le nom de la feuille où se trouvent les valeurs
Set Fe = ThisWorkbook.Worksheets("Feuil1")
'crée le classeur avec une seule feuille
Set Cls = Workbooks.Add(1)
'défini la plage pour la récupération des valeurs
With Fe
    Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'passe la plage de 10 en 10
For i = 1 To Plage.Count Step 11
    'ajoute une feuille au classeur en dernière position
    Set FeAjout = Cls.Worksheets.Add(After:=Cls.Worksheets(1))
    'renomme la feuille au nom du patient
    FeAjout.Name = Plage(i)
    'puis les colle de A1 à A10
    FeAjout.Range("A1:A9").Value = Fe.Range(Plage(i + 1), Plage(i + 9)).Value
Next i
Set Fe = Nothing
Set Plage = Nothing
Set FeAjout = Nothing
'Supprime la feuille vide
Application.DisplayAlerts = False
Cls.Worksheets(1).Delete
Cls.Worksheets(1).Activate
'On enregistre Cls dans Chemin sous ce format NomDDMMAAAA
Chemin = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
Cls.SaveAs Chemin & "Toto" & Format(Date, "ddmmyyyy") & ".xlsx"
Application.DisplayAlerts = True
Cls.Close
Set Cls = Nothing
End Sub

Attention quand même si tu as 2 patients qui ont le même nom ou si le fichier Toto03032011.xlsx est ouvert.