Création automatique d'onglets [Résolu]

[papaclab]

Bonjour.

Dans un classer Excel 2003, j'ai un tableau comportant 58 colonnes où le nombre de ligne est aléatoire (onglet nommé Data brut).
La première ligne de cet onglet contient l'entête des colonnes.

J'aimerais pouvoir, suite au clic sur un bouton situé sur une autre feuille (nommée Récap), créer automatiquement des onglets suivant les critères suivants :
- toutes les lignes dont la valeur du champ contenu dans la colonne AXxx est identique seraient copiées dans ce nouvel onglet.
- nom de l'onglet égal à la valeur de ce champ.
- et en première ligne l'entête des colonnes contenues dans le tableau principal.
Et ce autant de fois qu'il y a de valeurs différentes dans le champ AXxx.

J'espère m'être bien fait comprendre.
Merci par avance de l'aide que vous pouvez m'apporter.
Frank.

[jfontaine]

Bonjour,

Cette solution boucle sur les lignes de l'onglet Source (shSource) et ajoute la ligne dans l'onglet ayant un nom identique à la valeur de la cellule en colonne A.

Code :

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
Sub a()
 
Dim shSource As Worksheet
Dim sh As Worksheet
 
Dim i As Long
 
Set shSource = Sheets("data")
 
For i = 2 To shSource.Range("A65536").End(xlUp).Row
 
    If FeuilleExist(shSource.Range("A" & i).Value) = False Then
        'Création nouvelle feuille
        Set sh = ThisWorkbook.Worksheets.Add
        sh.Name = shSource.Range("A" & i).Value
        shSource.Rows(1).Copy sh.Rows(1)
    Else
        Set sh = ThisWorkbook.Worksheets(shSource.Range("A" & i).Value)
    End If
 
    'Copie la ligne
    shSource.Rows(i).Copy sh.Rows(sh.Range("A65536").End(xlUp).Row + 1)
 
Next i
 
End Sub

On utilise la fonction ci dessous pour retourner true si l'onglet existe

Code :

1
2
3
4
5
6
7
8
9
10
11
Function FeuilleExist(Nom As String) As Boolean
Dim sh As Worksheet
 
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = Nom Then
        FeuilleExist = True
        Exit Function
    End If
Next sh
FeuilleExist = False
End Function

[papaclab]

Super, ça marche.
Merci beaucoup.