Creation d'onglet en fonction de valeur dans une colonne

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 "Données" ; j'ai :

Nom Prix M²

Lille 152 236

Lille 153 200

Lille 154 190

Lille 155 25

Lens 215 256

Lens 100 258

Lens 510 700

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

Pour l'onglet "Lille" les données suivantes :

Nom Prix M²

Lille 152 236

Lille 153 200

Lille 154 190

Lille 155 25

Pour l'onglet "Lens" les données suivantes :

Nom Prix M²

Lens 215 256

Lens 100 258

Lens 510 700

Bien sur, dans mon exemple, il n'y a que 3 colonnes mais en réalité, il y a en 15. 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

Chnordiste

Bonjour,

Cet exemple s'adapte a ta plage (lignes et colonnes) de manière transparente

https://www.excel-pratique.com/~files/doc/chnordiste.xls

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

Bonjour,

J'ai envoyé un fichier avec le message mais je ne sais où il est ?

j'ai trouvé en relisant les infos du forum.

Le lien est dans le message précédent

MERCI cela fonction...

MERCI MERCI MERCI....

Chnordiste

Bonjour

J'ai besoin de la même chose mais mes données collectées sont dans la colonne C à partir de la ligne 11

J'ai essayé de changer le range mais je dois passer à côté de quelque chose d'autre.

Quelqu'un pourrait il m'aiguiller?