Bonjour,

Je suis sous Excel 2007. J’ai une macro qui me génère X onglets excel à partir d'une feuille excel (en fait la macro 'split' la feuille Sheet n°1 en autant d'onglets excel qu'il y a termes différents dans la colonne B de Sheet n°1). De plus, la macro « devrait » recopier l’entête du tableau initial dans chaque onglet créé et insérer une ligne en tout début d’onglet pour afficher un titre. « Devrait » car justement, c’est ces 2 étapes là qui me pose problème…

A partir du fichier initial :

Sujet Age (an) Poids (kg)
100 0 3
100 1 9
100 2 12
100 3 15
101 2 9
101 3 11
102 0 4
103 0 2

Je souhaiterai obtenir :

Onglet '100' :
Age (an)
Sujet Age (an) Poids (kg)
100 0 3
100 1 9
100 2 12
100 3 15

Onglet '101'
Age (an)
Sujet Age (an) Poids (kg)
101 2 9
101 3 11


Onglet '102'
Age (an)
Sujet Age (an) Poids (kg)
102 0 4

Onglet '103'
Age (an)
Sujet Age (an) Poids (kg)
103 0 2


Mais pour le moment, je n’obtiens que :
Onglet '100'
Sujet Age (an) Poids (kg)
100 0 3
100 1 9
100 2 12
100 3 15

Onglet '101'
Sujet Age (an) Poids (kg)
101 2 9
101 3 11


Onglet '102'
102 0 4

Onglet '103'
103 0 2

En fait, je ne parviens pas à insérer le titre de l’onglet : Age (an).
Et lorsqu’il n’y a qu’une seule ligne dans mon fichier initial, l’entête ne se créée pas (exemple onglets 102 et 103).

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
Sub Creation_Onglets()
Dim Ws As Worksheet
Dim trouve As Boolean
Dim contenu As String
Dim lig, derlig As Integer
With Sheets("Sheet n°1") 'feuille ou sont les données initiales
derlig = .Range("A65536").End(xlUp).Row 'A = colonne contenant le séparateur d'onglet
For lig = 1 To derlig
contenu = .Cells(lig, 1).Value '1 = 1ère col cf A ci dessus
For Each Ws In ThisWorkbook.Worksheets
trouve = False
        If StrComp(Ws.Name, contenu, vbTextCompare) = 0 Then
            trouve = True
            Exit For
        End If
Next Ws
If trouve = True Then
        .Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)
        Worksheets("Sujet").Range("A2:M2").Copy Ws.Range("A1:M1")
        'Worksheets("Sujet").Range("B2").Copy Ws.Range("A1")
    Else
        Sheets.Add
        ActiveSheet.Name = contenu
        .Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)
        'ActiveSheet.Rows(1).Insert
End If
Next lig
End With
End Sub
Avez-vous une solution ?

Merci d’avance pour votre aide qui me sera très utile.

Aude_alti