Extraire des lignes complètes de données

[alexcle]

Bonjour,
Je travaille avec un fichier excel 2003 (Plusieurs milliers de lignes et 15 colonnes). Je souhaiterai extraire en fonction d'un identifant (colonne A = nom ), l'ensemble des données en lignes et pour chacun des identifiants les avoir sur une feuille différente.

D'avance merci pour votre aide

A+ Florent

 

[JCGL]

Re : Extraire des lignes complètes de données

Bonjour à tous,

Un code de Ti 🙂 qui me sert régulièrment

'Ti http://www.veriti.net
'février 2008
Option Explicit

Private Sub CreeFeuille(ByVal Groupe$, Plage As Range)
Dim Cel As Range, Dest As Range, Ws As Worksheet
  On Error Resume Next
  With ThisWorkbook
      Set Ws = .Worksheets(Groupe)
    If Not Ws Is Nothing Then Exit Sub
    Set Ws = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
  End With
  With Ws
    .Name = Groupe
    .Range("A1:D1") = Array("Numéro", "Groupe", "Somme", "Rachat")
    Set Dest = .Range("A2")
    For Each Cel In Plage
      If Cel = Groupe Then
        Cel(1, 0).Resize(, 4).Copy Dest
        Set Dest = Dest.Offset(1, 0)
      End If
    Next Cel
  End With
End Sub

Sub CreeDEC()
Dim Ws As Worksheet, Plage As Range, Cel As Range
Dim Col As Collection, Groupe
  On Error Resume Next
 Application.ScreenUpdating = False
  Set Ws = ThisWorkbook.Worksheets("Data")
  With Ws
    Set Plage = .Range("B2", .Range("B65536").End(xlUp))
  End With
  Set Col = New Collection

  For Each Cel In Plage
    Col.Add Cel, CStr(Cel)
  Next Cel
  For Each Groupe In Col
    CreeFeuille Groupe, Plage
  Next Groupe
  Ws.Activate
  Application.ScreenUpdating = True
End Sub

Je ne souhaite pas joindre le fichier donc à adapter à ton fichier... que tu n'as pas joint non plus

A+

 

[alexcle]

Re : Extraire des lignes complètes de données

Pas de problème , voici le fichier il ya sur l'original beaucoup plus de lignes et de colonnes.
Si tu peux expliciter ton process, je suis preneur.
Merci

 

[ChTi160]

Re : Extraire des lignes complètes de données

Salut alexcle
Bonsoir le fil "un coucou particulier à JC"

En pièce jointe une autre possibilité à partir de la macro de Ti "que je salue lui aussi Lol"

Le fichier : Regarde la pièce jointe EssaiV2.zip

Bonne fin de journée

 

[JCGL]

Re : Extraire des lignes complètes de données

Bonjour à tous,

Un essai avec le code de Ti, à peine modifié.

A+

Edition : Salut JM Tchou-Tchou 🙂

 

[alexcle]

Re : Extraire des lignes complètes de données

je vais essayer les deux methodes , Merci pour tous

 

[Cousinhub]

Re : Extraire des lignes complètes de données

Bonsoir, Alexcle

salut, les deux 🙂🙂

une autre méthode, pour faire avancer le schmilblick....

Sub feuille_par_nom()
Application.ScreenUpdating = False
Dim Cel As Range, Noms As Object, Itm
Dim DerLig As Long
Set Noms = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
    DerLig = .[A65000].End(xlUp).Row
    .Range("A1:H" & DerLig).Name = "mabase"
    For Each Cel In .Range("A2:A" & DerLig)
        If Not Noms.Exists(Cel.Value) Then Noms.Add Cel.Value, Cel.Value
    Next Cel
    .[IV1] = .[A1]
    For Each Itm In Noms.items
        .[IV2] = Itm
        On Error Resume Next
        If Sheets(Itm).Range("A1").Value = .Range("A1").Value Then
            If Err.Number <> 9 Then
                Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
                    .Range("IV1:IV2"), CopyToRange:=Sheets(Itm).Range("A1:H1"), Unique:=False
            Else
                Sheets.Add.Name = Itm
                [A1:H1].Value = .[A1:H1].Value
                Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
                    .Range("IV1:IV2"), CopyToRange:=Range("A1:H1"), Unique:=False
            End If
        End If
    Next Itm
.Columns(256).Delete Shift:=xlToLeft
End With

A vos marques, prêt.......