Discussion :

[Vadorblanc]

Bonjour
J'ai trouvé ce code qui créer des onglets à partir d'une plage de cellule et qui nomme les onglets en fonction des noms mis dans la plage, super...
Mais je voudrais l'adapter sur une plage définie en colonne J qui comporte un certains nombre de 1, puis de 2, etc...
Je souhaiterais donc avoir la création d'un onglet se nommant du même nombre, c'est à dire 1, puis un autre onglet se nommant 2, etc...

Colonne J
1
1
1
1
2
2
2
2
2
2
3
3
4
5
5
5
si j'applique le code ci joint, j'aurais autant d'onglets que de numéro de lignes, mais je souhaiterais avoir un onglet nommé 1, un autre onglet nommé 2, un autre onglet nommé 3, etc... une boucle, mais là je rame.
Merci pour l'aide

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
Sub Module1CreationOnglet()
  ActiveCell.CurrentRegion.Select                    'Sélection du tableau (région actuelle)
  Dim Tableau() As String                            'Création d'un tableau de texte
  ReDim Tableau(1 To ActiveCell.CurrentRegion.Count) 'que nous redimensionnons en le nombre de cellules
                                                     'que contient notre sélection
 
  For Ctr = 1 To ActiveCell.CurrentRegion.Count      'Remplissage de ce tableau avec les différents éléments
    Tableau(Ctr) = ActiveCell.CurrentRegion(Ctr)     'est le nombre de cellules
  Next
 
  For Ctr = 1 To ActiveCell.CurrentRegion.Count       'On recommence la boucle
    Sheets.Add , Sheets(Sheets.Count)                 'cette fois pour créer les onglets réellement
    Sheets(Sheets.Count).Name = Tableau(Ctr)          'chaque onglet étant créé après le denier onglet
  Next                                                'Dans un deuxième temps, il s'agit de le renommer
End Sub

[mercatog]

Bonjour
une proposition

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
Sub Test()
Dim Sh As Worksheet
Dim LastLig As Long, i As Long
 
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "J").End(xlUp).Row
    For i = LastLig To 2 Step -1
        On Error Resume Next
        Set Sh = Sheets(CStr(.Range("J" & i).Value))
        On Error GoTo 0
        If Sh Is Nothing Then
            ThisWorkbook.Sheets.Add.Name = CStr(.Range("J" & i).Value)
        Else
            Set Sh = Nothing
        End If
    Next i
End With
End Sub

[Vadorblanc]

Bonjour Mercatog,
C'est parfait, ta boucle fonctionne à merveille, je suis ravi...je peux aller jusqu'à 250 onglets avec mon Excel 2003, c'est génial ...

Je ne sais pas s'il faut changer de post pour cette autre demande...
J'ose demander la cerise sur le gâteau... copier dans la création de l'onglet 1la ligne des titres qui est toujours en A1:J1 avec les lignes correspondants de la colonne J qui ont les 1 , puis dans l'onglet 2 la lignes des titres qui est toujours en A1:J1 avec les lignes correspondants de la colonne J qui ont les 2, etc... (nota les lignes sont toujours les cellules des colonne A B C D E F J)


A B C D E F J
blablabla.....1
blablabla.....1
blablabla.....1
blablabla.....2
blablabla.....2
blablabla.....2
blablabla.....3

Un grand merci

[mercatog]

Et si ta feuille nommée 1 existe déjà?
a. la passer sans rien faire
ou
b. la supprimer et créer une nouvelle feuille nommée 1?

Pour répondre à ta seconde question ( cas a.)

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
Public Sub Test2()
Dim Sh As Worksheet
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "J").End(xlUp).Row
    For i = LastLig To 2 Step -1
        On Error Resume Next
        Set Sh = Sheets(CStr(.Range("J" & i).Value))
        On Error GoTo 0
        If Sh Is Nothing Then
            Set Sh = ThisWorkbook.Sheets.Add
            Sh.Name = CStr(.Range("J" & i).Value)
            .Range("A1:J1").Copy Sh.Range("A1")
        End If
        Set Sh = Nothing
    Next i
End With
End Sub

[Vadorblanc]

Mercatog
Je garde le cas A car le nom de l'onglet Feuil1 ne sera jamais identique aux valeurs des cellules de la colonne J.

Ton code fonctionne très bien pour la ligne des titres qui se retrouve sur tous les onglets, super, mais il manque le contenu "blablabla"des cellules de col A à col J correspondant autant de fois qu'il y a de 1 dans la colonne J pour l'onglet 1, etc pour les autres onglets.
De plus les largeurs des colonnes des onglets crées sont par défaut à 10,71 différents de ma feuil1 de données, mais je verrais après si je fais une autre macro pour ma mise en page de tous les onglets.
Encore merci

[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
Public Sub Test3()
Dim Sh As Worksheet
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "J").End(xlUp).Row
    For i = LastLig To 2 Step -1
        On Error Resume Next
        Set Sh = Sheets(CStr(.Range("J" & i).Value))
        On Error GoTo 0
        If Sh Is Nothing Then
            Set Sh = ThisWorkbook.Sheets.Add
            Sh.Name = CStr(.Range("J" & i).Value)
            .Range("A1:J" & LastLig).AutoFilter field:=10, Criteria1:=.Range("J" & i).Value
            .Range("A1:J" & LastLig).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("A1").PasteSpecial xlPasteColumnWidths
            Sh.Range("A1").PasteSpecial xlPasteAll
            Application.CutCopyMode = False
        End If
        Set Sh = Nothing
    Next i
    .AutoFilterMode = False
End With
End Sub