XL 2013 Fractionner 1 fichier de plusieurs onglets en plusieurs fichiers

davel91

XLDnaute Nouveau
Bonjour à tous,

J'ai un fichier comportant 4 onglets. Dans tous les onglets une colonne EPCI permettant de faire des regroupements.

Pouvez-vous m'aider à faire un script pour avoir un fichier par EPCI avec les données qui le concerne uniquement, avec les 4 mêmes onglets (en reprenant leurs noms)
Chaque fichier porte le nom de chaque EPCI.

En terme de volume, 250 fichiers à créer, avec des onglets de 5000 à 6000 lignes. J'ai apuré et modifié pour test.
J'ai repris un script existant et adapté mais cela ne fonctionne que pour 1 onglet (pas les 4 en même temps).

Merci pour votre aide
 

Pièces jointes

  • Trame EPCI.xlsm
    33.1 KB · Affichages: 15

davel91

XLDnaute Nouveau
Pour les réfractaires à ouvrir le fichier. Le code actuel :
VB:
Sub GénérerClasseurs()
    Dim aa, rh, ln, EPCI(), plgET As Range, chD$, k%, n&, i&, d As Object
    With Worksheets("Etat 2")
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        If i <= 1 Then Exit Sub
        k = .Cells.SpecialCells(xlCellTypeLastCell).Column
        aa = .Range("A2:A" & i).Resize(, k).Value
        Set plgET = .Range("A1:A1").Resize(, k)
    End With
    chD = ThisWorkbook.Path & "\"
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
    Next i
    Application.ScreenUpdating = False
    For Each rh In d.keys
        ln = Split(d(rh), ";"): n = UBound(ln)
        ReDim EPCI(1 To n)
        For i = 1 To n
            EPCI(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
        Next i
        With Workbooks.Add(xlWBATWorksheet)
            With .Worksheets(1)
                plgET.Copy .Range("A1")
                With .Range("A2").Resize(n, k)
                    .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(EPCI))
                    .Borders.Weight = xlThin
                End With
            End With
            .SaveAs chD & rh & ".xlsx"
            .Close
        End With
    Next rh
End Sub

Malheureusement j'ai très peu de notion de VBA, je peux la comprendre et faire quelques petits réglages mais pas rajouter de boucle pour les onglets ou optimiser le VBA.

Merci
 

zebanx

XLDnaute Accro
Bonjour Davel91, le forum

Bienvenu déjà sur le site.

Je ne suis pas reparti de votre code mais vous propose une série de 3 macros qui, de ma compréhension, doivent aboutir à un résultat proche.

Préalable :
Que les 250 fichiers portent sur des EPCI différentes. Le premier fichier traite de Brest, Bordeaux et Annemasse les Voirons mais le fichier porte 2 porte sur d'autres villes et ainsi de suite.
Pourquoi ? Pour ne pas écraser les fichiers créés

Proposé :
1/ On déconsolide chaque fichier en créant une worksheet pour chaque EPCI et suivant chaque nom de ville retrouvée en colonne A
2/ On exporte les fichiers crées suivant chaque EPCI (Bonjour et merci Pierrejean pour la macro :cool: )
3/ On peut supprimer si on le souhaite les worksheets créés en 1.

Le traitement serait différent si les valeurs des EPCI se recoupent dans les 250 fichiers.
Là, il faudrait faire d'autres boucles.

Et il faudra prévoir de faire appel à ces macros pour chacun des 250 fichiers contenus dans un répertoire bien ciblé. Ca c'est encore un autre sujet. Normalement pas trop long à traiter mais je suis bien rouillé...

A vos commentaires

xl-ment
zebanx

ps : enregistrer le fichier à charger avant de lancer les macros svp.
 

Pièces jointes

  • Trame EPCI.xlsm
    68.4 KB · Affichages: 9

Discussions similaires

Réponses
5
Affichages
335
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla