Extraction les lignes respectant une valeur specifique dans une des cellule

Bonjour a tous,

j'ai un fichier excel dont le sample est joint a ce message. J'ai une feuille data dont les donnees se repartissent sur plusieurs lignes et colonnes, cependant dans chaque ligne a la colonne 2 certains cellules ont les memes valeurs. Je voudrais extraire les lignes ayant les memes valeurs au niveau de la colonne 2 et les mettre dans une nouvelle feuille. Je viens de joindre un fichier d'illustration.

J'ai besoin de votre aide s'il vous plait.

Merci!

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour gmb!

J'ai du soucis pour l'adapter a mon fichier original. Si j'execute le macro, ca crache completement.

C'est un document avec 21 colonnes et plus de 3000 lignes. la colonne est D et ca commence a D8 dans le fichier original.

y'a ti'il un moyen d'eviter que ca crache.

Merci!

J'ai du soucis pour l'adapter a mon fichier original.

Pourquoi ne joins-tu pas ton fichier original ?

Bye !

Pour soucis de confidentialite.

je te mets quand meme.

Ici, on fait par centre ATS, ie la colonne D. les valeurs de cellules commencent a D8 et ca continue.

pour l'entete, on maintient uniquement la ligne 6(comme ligne des titres des colonnes).

Merci!

Nouvelle version

Option Explicit

Dim tablo, f As Worksheet, fdep As Worksheet
Dim i&, j&, ln&

Sub Extraire()

    Set fdep = ActiveSheet
    tablo = Range("A6:U" & Range("A" & Rows.Count).End(xlUp).Row)
    Application.ScreenUpdating = False
    For i = 3 To UBound(tablo, 1)
        On Error Resume Next
        Set f = Sheets(Trim(tablo(i, 4)))
        If Err.Number <> 0 Then
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Trim(tablo(i, 4))
            Set f = ActiveSheet
            For j = 1 To UBound(tablo, 2)
                f.Cells(1, j) = tablo(1, j)
                f.Cells(2, j).Value = tablo(i, j)
            Next j
        Else
            ln = f.Range("A" & Rows.Count).End(xlUp)(2).Row
            For j = 1 To UBound(tablo, 2)
                f.Cells(ln, j).Value = tablo(i, j)
            Next j
        End If
    Next i
    fdep.Activate
End Sub

Bye !

Merci beaucoup , ca marche tres bien!

Salut les amis

Est ce possible de faire le recap dans un tableau par nombre d'occurrence.

Je m'explique , Au lieu de creer des feuilles et regrouper les elements pour chaque occurence, je veux cette fois si mettre en place sur une feuille le nombre d'occurence de chacun.

Bonjour

Nouvelle version

Sub Occurences()

    Set fdep = ActiveSheet
    tablo = Range("D8:D" & Range("D" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(tablo, 1)
        nom = Trim(WorksheetFunction.Proper(tablo(i, 1)))
        If dico.exists(nom) Then
            dico(nom) = dico(nom) + 1
        Else
            dico(nom) = 1
        End If
    Next i
    With Sheets("Occurences")
        .Range("A1").CurrentRegion.Offset(1, 0).Clear
        .Range("A2").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
        .Range("B2").Resize(dico.Count, 1) = Application.Transpose(dico.items)
        .Range("A2").Resize(dico.Count, 2).Sort key1:=.Range("A2"), order1:=xlAscending, Header:=xlNo
        .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
        .Activate
    End With
End Sub

Bye !

Merci infiniment!