Ventiler mon fichier .xls en plusieurs fichiers .xls

[Quincy]

Bonjour à tous

Je cherche à découper et ventiler mon fichier Excel (environ 600 lignes) en autant de fichiers Excel que de cantons dans la colonne B tout en gardant la structure du tableau afin d'obtenir un fichier Amplepuis.xls, un fichier Anse. xls, ainsi de suite.

Que me conseillez-vous SVP ?
Je vous joins mon fichier à traiter avec quelques lignes pour mieux comprendre.
Merci beaucoup.
Cordialement

Quincy

 

[Caillou]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Bonjour Quincy,

Une petit macro que j'avais bricolé y'a quelque temps (peut-être que cela pourra te servir)
Pour l'utiliser tu dois sélectionner une seule cellule de ta liste et exécuter la macro BDD_Extraction, ensuite tu te laisses guider (tu peux extraire sur des feuilles dans le classeur ou sur des classeurs séparés; dans ce cas les fichiers sont enregistrés dans le dossier du classeur principal)

Bon courage

Caillou

 

[Quincy]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Bonjour Caillou

Merci pour ta réponse, je vais tester ta macro de suite.
Cordialement.
Quincy

 

[BOISGONTIER]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Bonjour,

Voir PJ

Sub Extrait()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("Test").Select
  '--- Liste des services
  [A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[K1], Unique:=True
  For Each c In Range("K2", [K65000].End(xlUp))   ' pour chaque service
     [K2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Delete
     On Error GoTo 0
     Sheets.Add After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = c.Value
     '-- extraction
     Sheets("Test").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("Test").[K1:K2], CopyToRange:=[A1]
     Sheets("Test").Select
   Next c
End Sub

JB

 

[Quincy]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Re, bonjour BOISGONTIER

Caillou --> ta macro parait très au point (même si en pas à pas je n'ai rien compris) le résultat est là. Cependant, pourquoi les colonnes perdent-elles leur format ?

BOISGONTIER --> ta macro marche super et je te remercie. Seulement ce que je souhaiterais c'est obtenir plusieurs classeurs et non plusieurs onglets.

Je vais tenter de modifier la macro de Caillou.
Merci à vous deux.
Cordialement
Quincy

 

[BOISGONTIER]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Voir PJ

Sub CreeClasseurs()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  [A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[K1], Unique:=True
  For Each c In Range("K2", Range("K65000").End(xlUp))
     Range("K2") = c
     Sheets("Modèle").Select
     [A2:I100].Clear
     Sheets("Test").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("Test").[K1:K2], CopyToRange:=Sheets("Modèle").[A1:I1], Unique:=False
       ActiveSheet.Copy
       ActiveSheet.Name = c
       ActiveWorkbook.SaveAs Filename:=c
       ActiveWorkbook.Close
       Sheets("Test").Select
    Next c
End Sub

JB

 

[Quincy]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Re,

Ok merci BOISGONTIER

Décidemment que j'opte pour l'une ou l'autre j'ai toujours mon problème de largeur de colonnes. Y aurait-il un moyen de déclarer dans la macro que la colonne A est à tant, la colonne B à tant etc...?

Quincy

 

[Caillou]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

re,

1. la macro sélectionne la zone en cours
2. elle place la 1ère ligne de la sélection dans le 1er combobox
3. elle utilise le principe du dictionnaire (Scripting.Dictionary) pour extraire les valeurs distinctes dans la colonne choisie
4. tri de ces données
5. qui sont placées dans le 2ème combobox
6. ensuite pour chaque valeur dans la 2ème combobox, filtre automatique de la valeur
7. copier/coller sur une nouvelle feuille - et c'est là où se situe ton soucis car comme la macro sélectionne la zone en cours (CTRL *) les largeurs de colonnes ne sont pas reprises -

Caillou

 

[BOISGONTIER]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Régler la largeur des colonnes dans l'onglet Modèle
(On peut l'automatiser)

JB

 

[Quincy]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

re,

entendu Caillou et BOISGONTIER, je testerai cela.
Pour l'heure, je dois m'absenter, mais je vous tiendrai au courant.

Merci à tous.
Quincy

 

[Quincy]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

Bonjour le forum

Finalement j'ai opté pour la méthode de Caillou, avec l'userform c'est sympa et cela permet d'utiliser d'autres colonnes. Je l'ai aménagée avec quelques élements de la macro de BOISGONTIER et cela me convient comme cela.
Encore merci à vous deux et bonne journée à tous.

Quincy

 

[melaika]

Re : Ventiler mon fichier .xls en plusieurs fichiers .xls

bonjour ;

svp aidez moi j'ai besoin du même principe mais envoyé chaque fichier à l'employé concerné avec son responsable en copie selon l'exemple en attachement
avec objet mail exemple portefeuille 2015
et contenu du mail "bonjour merci de trouver en attachement le détail "
nb: si vous pouvez aussi supprimer la colonne employé et responsable à la fin

merci pour votre support

 

[AurélienGrenoble]

Bonjour,

J'ai utilisé la macro mis en place par Cailloux. cela fonctionne très bien. Le problème est que j'ai beaucoup d'export à faire (2000 environs). Est-il possible de ne pas ouvrir les fichiers créer ou alors de les fermer après leur création .


Merci bien pour votre aide

Aurélien
Voici le code utilisé :

'
'Publiques
Public nb_champ As Byte 'le nombre de champs de la bdd (le cas échéant)
Public nb_enreg As Long 'le nombre d'enregistrements de la bdd (le cas échéant)

'
'Privées
Dim w As Window 'la fenêtre active
Dim f As Worksheet 'la feuille active
'


'
'Sélectionne la BDD en cours, demande à l'user de sélectionner un champ
'puis extrait les données similaires de ce champ
'dans des nouvelles feuilles ou fichiers
'
Sub BDD_Extraction()
Dim c As Range 'la cellule active
Dim x As Boolean 'valeur de retour de la fonction info_bdd
'Mémorise le fichier en cours (fenêtre)
Set w = ActiveWindow
'Mémorise la feuille en cours
Set f = ActiveSheet
'Mémorise la cellule active
Set c = ActiveCell
'Sélectionne la zone en cours
c.CurrentRegion.Select
x = Info_bdd(Selection)
'Affiche le formulaire
If x Then Frm_1.Show
End Sub

'
'Extrait le résultat du filtre (la valeur du filtre est reçue en argument)
'sur une nouvelle feuille insérée à la fin du classeur
'le nom de la feuille est la valeur filtrée
'
Public Sub Extract_Feuille(Nom)
On Error Resume Next
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet
.Select
.Paste
.Name = Nom
End With
Application.CutCopyMode = False
f.Select
End Sub

'
'Extrait le résultat du filtre (la valeur du filtre est reçue en argument)
'dans un nouveau classeur
'le nom du classeur est la valeur filtrée
'
Public Sub Extract_Fichier(Nom)
On Error Resume Next
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Nom
w.Activate
End Sub

'
'Filtre la liste sur la colonne reçue en argument1
'avec les données reçues en argument2
'
Public Sub Select_Un_Groupe(IdCol, ValeurCol)
Selection.AutoFilter
Selection.AutoFilter Field:=IdCol, Criteria1:=ValeurCol

End Sub

'
'
'
'
Public Function Info_bdd(bdd As Range) As Boolean
With bdd
nb_champ = .Columns.Count
nb_enreg = .Rows.Count - 1
If nb_enreg > 1 Then
Info_bdd = True
Else
Info_bdd = False
End If
End With
End Function