Eclater un fichier Excel en plusieurs feuilles selon des critères

Bonjour à tous,

J'ai besoin, à partir d'une liste de critères, éclater le fichier xl en plusieurs fichiers.

J'ai donc été chercher sur le forum et j'ai trouvé des macros qui me permettent de le faire.

Pour autant, je n'ai pas besoin que toutes les lignes soient éclatées mais uniquement certaines.

Dans le fichier en PJ, par exemple, j'aurais besoin que seuls les critères A, B, C et D soient éclatées dans des fichiers différents.

En gros, je n'arrive pas créer une liste de critères dans la macro.

Si je ne suis pas clair, n'hésitez pas !

Merci d'avance

Bonjour Sopragio et bienvenu, bonjour le forum,

Le titre : Eclater un fichier excel en plusieurs feuilles selon des critères

L'énoncé 1 : éclater le fichier xl en plusieurs [b]colonnes

[/b]L'énoncé 2 : soient éclatées dans des fichiers différents.

Heu... Commence par bien réfléchir à ce que tu veux vraiment, puis revient, non !?...

Vu le fichier test éclater c'est pas vraiment le terme le plus adapter.

2 colonnes et filtrage des données si colonne A contiend A B C ou D

Un simple tableau croisé te permet de filtrer ce que tu veux et si tu as besoin d'un onglet à part pour ton résultat ; un double clic

sur le résultat d'un Tableau croisé te créé ton onglet avec les infos sélectionnées.

Bonjour sopragio et bienvenue

Mazel Tov, Félicitations, tu as touché le graal avec un code macro tout pourri, alambiqué, incompréhensible. Qu'est-ce que c'est que ce bazar ?

Je peux en parler car c'est moi qui l'ai écrit il y a fort longtemps, à l'époque où je ne savais pas encore faire simple en VBA. Par contre il a fait son job et continue de le faire ... mais tu ne dois pas en prendre une partie !

Bon, je pense qu'il est temps que je ré-écrive cela ! et avec une liste de codes comme tu le souhaites !

Option Explicit

Sub fractionner()
Dim Tbl As Variant, data As Variant, i%, prov As String
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim xl As Excel.Application, wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    data = ActiveSheet.Cells(1, 1).CurrentRegion

    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = LBound(data) + 1 To UBound(data) ' hors en-tête
        If IsNumeric(Application.Match(data(i, 1), Sheets("criteres").Columns("A"), 0)) Then dico1(data(i, 1)) = ""
    Next

    Set xl = CreateObject("Excel.Application")
    xl.SheetsInNewWorkbook = 1

    For Each cle1 In dico1.Keys
        Set wb = xl.Workbooks.Add
        data(1, 1) = cle1                      ' pour emmener aussi l'en-tête
        result1 = filtreArray(data, 1, cle1)
        wb.Sheets(1).Cells(1, 1).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
        wb.SaveAs (MonRepertoire & "\" & cle1 & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next
    xl.Quit
    Set xl = Nothing
    MsgBox "Terminé !"

End Sub