Tri et découpe

Berg1664

XLDnaute Occasionnel
Bonjour

Je cherche à automatiser l'opération suivante, trier un fichier et copier le résultat de chaque tri dans un onglet différent

Je voudrais par exemple trier par ville et mettre le résultat de chaque ville dans un onglet , c'est ce que j'ai fait manuellement dans le fichier joint

Je me casse les dents sur ça, je n 'ai pas trouver de fil sur ce sujet

Merci pour votre aide qui me sera comme d'habitude précieuse.
Berg1664
 

Pièces jointes

  • Découpe 3.xls
    136 KB · Affichages: 24

Efgé

XLDnaute Barbatruc
Re : Tri et découpe

Bonjour Berg1664

Sujet déja fait plusieurs foi.
VB:
Sub test()
Dim DFeuille As Object
Dim i&, F As Worksheet, FTst As Worksheet
Set DFeuille = CreateObject("Scripting.dictionary")
Set F = Sheets("Base de données")

Application.ScreenUpdating = False

For i = 2 To F.Cells(F.Rows.Count, 1).End(3).Row
    On Error Resume Next
    Set FTst = Sheets(F.Cells(i, 6).Value)
    If Err Then
        Err.Clear
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = F.Cells(i, 6).Value
        Set FTst = Sheets(F.Cells(i, 6).Value)
        F.Range(F.Cells(1, 1), F.Cells(1, 11)).Copy FTst.Cells(1, 1)
        DFeuille(F.Cells(i, 6).Value) = ""
    End If
    If Not DFeuille.exists(FTst.Name) Then
        FTst.Range(FTst.Cells(2, 1), FTst.Cells(FTst.Rows.Count, 1).End(3)(1, 11)).ClearContents
        DFeuille(FTst.Name) = ""
    End If
    F.Range(F.Cells(i, 1), F.Cells(i, 11)).Copy FTst.Cells(FTst.Rows.Count, 1).End(3)(2)
    Set FTst = Nothing
Next i

F.Activate
End Sub

Cordialement
 

Pièces jointes

  • Découpe(2).xls
    87.5 KB · Affichages: 28

Discussions similaires