Discussion :

[problemeaide]

Bonjour,

Je souhaiterai créer (avec votre aide ) une macro qui me permettra de créer un onglet pour chaque valeur différente d'une colonne. Je m'explique :

Dans une feuille "Nomenclature" ; j'ai en colonne E:
Villes
Lille
Nantes
Bordeaux
Lyon

Je voudrais créer automatiquement par le biais d'une macro les onglets suivants "Lille" et "Nantes" avec :

Pour l'onglet "Lille" les données de la feuille "G3"

De même que le nombre de création d'onglet en fonction des valeurs est différent d'une semaine, à une autre.

En vous remerciant par avance

[Jean-Philippe André]

Salut,

si on découpe le raisonnement de ton processus on aura donc besoin :
- d'une boucle qui passe sur les éléments de la colonne E
- d'une création d'une nouvelle feuille
- du renommage de la dite nouvelle feuille

En partant de ces éléments, saurais-tu nous dire lesquels te posent des soucis en termes de programmation VBA ?

[problemeaide]

Oui c'est exactement ça.

Je suis novice j'ai donc cherché à faire une étape puis les autres.
J'arrive à créer une feuille, mais pas à partir d'une colonne.
J'arrive à faire une boucle pour trouver le nombre de valeur de la colonne
Je sais renommer la feuille.

Je ne sais pas intégrer le tout dans une macro cohérente.

J'ai bien trouver des choses qui s'en rapproche mais quand je modifie et teste c'est un echec.

[problemeaide]

Je pensais utiliser çà. Je l'ai trouvé sur un site mais il copie en plus le texte des colonnes, mais je veux qu'il me copie le texte d'une autre feuille.
Mais je n'arrive pas à différentier se qui est à garder de se qui est à enlever. Son code ne contenant pas de commentaire

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
Sub Balaye()
    Dim NoDupes As New Collection
    Application.ScreenUpdating = False
    A = Range([A2], [A65536].End(xlUp)).Value
    On Error Resume Next
    ' Boucle pour récupérer la collection d'items uniques
    For j = 1 To UBound(A, 1)
        NoDupes.Add A(j, 1), CStr(A(j, 1))
    Next j
    ' Réactivation du gestionnaire d'erreurs
    On Error GoTo 0
    Range("A1").CurrentRegion.Select
    With Selection.CurrentRegion
        Intersect(.Cells, .Offset(1)).Select
    End With
    B = Selection.Value
    NbCol = Selection.Columns.Count
    [A1].Select
    ReDim Tableau(1 To UBound(B), 1 To NbCol)
    For k = 1 To UBound(B, 1)
        For z = 1 To NbCol
            Tableau(k, z) = B(k, z)
        Next z
    Next k
    H = 1
    For i = 1 To NoDupes.Count
        Sheets.Add after:=Sheets(i)
        ActiveSheet.Name = NoDupes(i)
        For x = 1 To UBound(A, 1)
            If Tableau(x, 1) = NoDupes(i) Then
                For w = 1 To NbCol
                    Cells(H + 1, w).Value = Tableau(x, w)
                Next w
                H = H + 1
            Else
            End If
        Next x
        H = 1
    Next i
    Sheets("Données").Activate
    NbSheet = ActiveWorkbook.Sheets.Count
    Range([A1], [IV1].End(xlToLeft)).Select
    Set MaPlage = Selection
    [A1].Select
    For NS = 2 To NbSheet
        Set Destination = ActiveWorkbook.Sheets(NS).Range("A1")
        MaPlage.Copy Destination
    Next NS
End Sub

[problemeaide]

Avec un peu de patience j'ai trouvé ça.

Par contre je n'ai pas le copier coller dans chaque feuille de ma feuille nommé G3 (il s'agit d'une feuille contenant de nombreuse formule qui change en fonction du nom de la feuille)

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
Option Explicit
 
Sub CreationFeuilles()
Dim J As Long
 
  Application.ScreenUpdating = False
 
  With Sheets("Nomenclature")
    For J = 2 To .Range("G" & Rows.Count).End(xlUp).Row
      If FeuilleExiste(.Range("G" & J).Value) = False Then
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = .Range("G" & J).Value
      End If
    Next J
  End With
End Sub
 
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function