separer une liste en deux

[choupi_nette]

Bonjour le forum,
J'ai besoin d'aide pour une macro...
J'ai dans le fichier joint une liste onglet choupi (dont le nombre de lignes varie)
Ce que je veux c'est obtenir les onglets resultats1 et resultat2...

Le critere pour les trier ? si colonne A ca passe d'une valeur a une autre alors on crée un onglet avec la nouvelle valeur

Je souhaiterais que la colonne de titre soit conservée pour les onglets resultats
Juste pour info jamais plus de 3 changements donc jamais plus de 3 onglets à créer

Merci

 

[Dranreb]

Re : separer une liste en deux

Bonjour

Sub Eclater()
Dim SourceRange As Range, TSrc() As Variant, L As Long, LDéb As Long, Onglet As String, FDst As Worksheet, LDst As Long
Set SourceRange = Intersect(Feuil1.[A2:A65536], Feuil1.UsedRange).Resize(, 17)
TSrc = SourceRange.Value
L = 1
Do: Rem. —— Début onglet
   LDéb = L: Onglet = TSrc(L, 1)
   Do: Rem. —— Détail
      L = L + 1: If L > UBound(TSrc, 1) Then Exit Do
      Loop Until TSrc(L, 1) <> Onglet
Rem. —— Fin onglet
   On Error Resume Next
   Set FDst = Worksheets("Résu" & Onglet)
   If Err Then Set FDst = Nothing
   On Error GoTo 0
   If FDst Is Nothing Then
      Set FDst = Worksheets.Add(After:=Worksheets(Worksheets.Count))
      FDst.Name = "Résu" & Onglet
      Feuil1.[A1:Q1].Copy Destination:=FDst.[A1]
      End If
   LDst = FDst.[F65536].End(xlUp).Row + 1 ' Ligne qui suit le dernier F non vide
   SourceRange.Rows(LDéb).Resize(L - LDéb).EntireRow.Copy Destination:=FDst.Cells(LDst, 1)
   FDst.Columns.AutoFit
   Loop Until L > UBound(TSrc, 1)
End Sub

À +

 

[flyonets44]

Re : separer une liste en deux

Bonjour
Voici ton fichier avec un filtre par macro
Cordialement
Flyonets

 

[choupi_nette]

Re : separer une liste en deux

Bonjour le fil,

Merci a vous pour vos reponses. Ca convient parfaitement
Excellente journée