XL 2019 Découper un fichier en fonction de cellules

[WTF]

Bonjour à tous.
J'ai généré un fichier à partir d'un outil interne. Celui ci me donne une liste de sociétés dans un fichier plat.
Je dois intégrer ce fichier dans un autre outil, et celui n'accepte :
- que les fichiers en CSV
- qu'un fichier par pays

Je voudrais donc pouvoir découper mon fichier en créant un nouveau fichier CSV en fonction du pays inscrit en colonne F.
Soit dans mon exemple :
- 1 fichier BE
- 1 fichier ES
- 1 fichier FR

Je peux bien sur avoir plus de lignes et de pays en fonction de ma requête.

Je cherche à faire une petite macro simple avec un bouton pour découper et enregistrer mes sous fichiers, dans le même répertoire que mon fichier global.
Merci à tous pour votre aide.

 

[Staple1600]

Bonsoir le fil, WTF

WTF
Voir en bas de page, dans les dix Discussions similaires
Tu devrais trouver de quoi façonner "ta petite macro"

 

[WTF]

Merci Staple de ta réponse

Je suis reparti d'un code de @JCGL que j'ai trouvé dans une ancienne discussions : https://www.excel-downloads.com/threads/macro-pour-decouper-un-fichier-excel.103527/

Et j'ai essayé de l'adapter à mon cas, qui est créer un nouveau fichier csv à chaque changement de code pays dans la colonne F (en gardant la ligne d'en-tête de colonne).
Malheureusement je ne suis vraiment pas doué en VBA et ca donne ca (qui ne fonctionne pas du tout ;-( )

Option Explicit
 
Sub Traitement()
'myDearFriend! - [URL="http://www.mdf-xlpages.com/"]mon Univers Excel... : myDearFriend! Excel Pages[/URL]
Dim CollPays As New Collection
Dim Plage As Range
Dim L As Long, L2 As Long, Lmax As Long
Application.ScreenUpdating = False
With Sheets("Fichier Import")
Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row
'Création de la liste des pays (sans doublons)
On Error Resume Next
For F = 2 To Lmax
CollPays.Add .Cells(F, 2).Text, .Cells(F, 2).Text
Next F
On Error GoTo 0
'Création des classeurs
For F = 2 To CollPays.Count
'Copie de l'onglet
.Copy
'Epurage des données par pays
With ActiveSheet
Set Plage = .Rows(Application.Rows.Count)
For F2 = 2 To Lmax
If .Cells(F2, 2).Text <> CollPays(F) Then
Set Plage = Union(Plage, .Rows(L2))
End If
Next L2
Plage.Delete
End With
'Sauvegarde classeur "pays X"
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Pays " & CollPays(F) & ".csv"
.Close
End With
Next F
End With

 

[WTF]

Bonjour le forum,

J'ai trouvé un autre code qui me semble plus adapté (https://forum.excel-pratique.com/viewtopic.php?t=92739)
J'y ai fait quelques modifs minimes mais qui sembles fonctionner.
Il me reste un pb. Actuellement, un nouveau fichier est créé pour chaque type d'info en colonne A et chez moi je souhaiterais que ce soit la colonne F, et je ne vois pas quelle partie du code changer. Je ne vois pas d'info Colunn, mais je ne cherche peut être pas la bonne chose...

Sub GénérerClasseurs()
    Dim d As Object, wbk As Workbook, k, itm, kitm, kk, et, f%, n%, i%, ch$, rw$
    Set d = CreateObject("Scripting.Dictionary")
    With ThisWorkbook
        For f = 1 To .Worksheets.Count
            With .Worksheets(f)
                n = .Cells(.Rows.Count, 1).End(xlUp).Row
                For i = 2 To n
                    kitm = .Cells(i, 1)
                    k = "wb_" & kitm: itm = "ws" & f
                    If d.exists(k) Then
                        If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
                    Else
                        d(k) = ";" & itm
                    End If
                    k = itm & "_" & kitm: kitm = kitm & "_" & itm: itm = "rw" & i
                    If d.exists(k) Then
                        If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
                    Else
                        d(k) = ";" & itm
                    End If
                    kitm = kitm & itm: itm = .Cells(i, 1).Resize(, 3).Value
                    d(kitm) = itm
                Next i
            End With
        Next f
        et = .Worksheets(1).Range("A1:W1").Value
        ch = .Path & "\"
    End With
    Application.ScreenUpdating = False
    For Each k In d.keys
        If k Like "wb_*" Then
            kitm = Split(k, "_")(1)
            Set wbk = Workbooks.Add(xlWBATWorksheet)
            wbk.SaveAs ch & kitm & ".csv"
            itm = Split(d(k), ";")
            With wbk
                If UBound(itm) > 1 Then
                    For f = 2 To UBound(itm)
                        .Worksheets.Add after:=.Worksheets(f - 1)
                    Next f
                End If
                For f = 1 To UBound(itm)
                    kk = Split(d(itm(f) & "_" & kitm), ";"): n = 1
                    With .Worksheets(f)
                        .Cells(n, 1).Resize(, 3).Value = et
                        For i = 1 To UBound(kk)
                            n = n + 1
                            rw = kitm & "_" & itm(f) & kk(i)
                            .Cells(n, 1).Resize(, 3).Value = d(rw)
                        Next i
                    End With
                Next f
                .Close True
            End With
        End If
        Set wbk = Nothing
    Next k
End Sub

 

[mapomme]

Bonjour @WTF ,

Sinon vous pouvez essayer le fichier joint et son code. Les fichiers sont créés dans le répertoire du fichier contenant la macro avec des noms du type Extraction- FR.csv La macro est commentée.

 

[WTF]

Bonjour Mapomme,
Merci beaucoup, ca fonctionne très bien, il y a juste un point sur le fichier CSV qui est créé.
Tout est dans la même cellule avec un séparateur ",'

Ca n'est pas très logique je sais, mais l'outil dans lequel je fais mon import veut :
- garder la mise en page du fichier actuel (c'est à dire des informations ventilées par colonne)
- enregistré au format CSV

Si jamais ca n'est pas possible je les convertirait manuellement, mais ca peut être un peu long vu le nombre de fichier que je vais créer...

 

[WTF]

J'ai réussi en modifiant un bout de ton code comme ca :

      'on sauvegarde le nouveau classeur sous format CSV
      wbk.SaveAs Filename:=fichier & ".csv", CreateBackup:=False

Un grand merci, et merci pour les précisions que tu inclues dans ton code, ca permet de comprendre ce qui se passe.

 

[mapomme]

Re,

il y a juste un point sur le fichier CSV qui est créé.
Tout est dans la même cellule avec un séparateur ",'

C'est normal. Un fichier CSV est un fichier TEXTE avec une structure particulière. Il y a une ligne pour chaque ligne de la feuille Excel. Les champs d'un fichier CSV créé par Excel (français) sont séparés par des points-virgules.

 

[mapomme]

Re,

J'ai réussi en modifiant un bout de ton code comme ca :

Donc tu n'a pas de fichier CSV mais un vrai fichier Excel. L'extension ne fait pas le fichier CSV !!!!
Ce n'est pas ce que tu demandais...

 

[WTF]

Donc tu n'a pas de fichier CSV mais un vrai fichier Excel. L'extension ne fait pas le fichier CSV !!!!
Ce ,'est pas ce que tu demandais...

Ok merci beaucoup en tout cas.
Je garde les 2 solutions et je fais des tests d'import de mon fichier pour voir ce qui fonctionne... Quoi qu'il arrive j'ai les 2 possibilités maintenant.

 

[WTF]

@mapomme ,
J'ai une question bête.
Dans le fichier que tu m'as envoyé, la macro est enregistrée dans un repertoire Module

Dans le fichier sur lequel je travail, je n'ai pas ce répertoire, mais uniquement le nom des onglets et ThisWorkbook.
Si je colle la macro j'ai un message qui me dit lors de l'exécution "L'indice n'appartient pas à la sélection"

1. Comment fait on pour avoir "Module'
2. Est ce que la macro s'appliquera bien qu'à l'onglet "Fichier_Import"

MErci

 

[mapomme]

Re,

1. Comment fait on pour avoir "Module'

• Aller dans l'environnement VBA
• Clique droit sur VBAProject (WTF- découper- v1.xlsm)
• choisir Insérer / Module
• le module de nom "Module1" sera créé

2. Est ce que la macro s'appliquera bien qu'à l'onglet "Fichier_Import"

Oui c'est la ligne de code: With Sheets("Fichier Import")

nota: plus dispo jusqu'à ce soir