Découpage fichier en fonction d'une colonne de référence

Bonjour,

Dans le module1 de ma macro, je n'arrive pas à faire en sorte que mon fichier soit découpé en X fichier à partir de la colonne de référence 1 en sachant que j'ai 14 colonnes qui vont de A à N

Quelqu'un peut il m'aider ?

Bonne journée.

Sub Traitement()

Dim CollMag As New Collection

Dim Plage As Range

Dim L As Long, L2 As Long, Lmax As Long

Application.ScreenUpdating = False

With Sheets("Feuil1") 'A adapter !

Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row

'Création de la liste des fournisseurs (sans doublons)

On Error Resume Next

For L = 2 To Lmax

CollMag.Add .Cells(L, 1).Text, .Cells(L, 1).Text

Next L

On Error GoTo 0

'Création des classeurs

For L = 2 To CollMag.Count

'Copie de l'onglet

.Copy

'Epurage des données par fournisseurs

With ActiveSheet

Set Plage = .Rows(Application.Rows.Count)

For L2 = 2 To Lmax

If .Cells(L2, 1).Text <> CollMag(L) Then

Set Plage = Union(Plage, .Rows(L2))

End If

Next L2

Plage.Delete

End With

'Sauvegarde classeur "Fournisseur X"

With ActiveWorkbook

.SaveAs ThisWorkbook.Path & "\Fournisseur " & CollMag(L) & ".xls"

.Close

End With

Next L

End With

Application.ScreenUpdating = True

MsgBox CollMag.Count & " classeurs créés"

End Sub

Bonsoir,

D'après ton code, et de ce que j'en comprends, tu voudrais créer un fichier par "type", ce "type" étant les valeurs "uniques" de la colonne A....

Je peux me tromper dans la compréhension, mais si j'ai "bon", je pense que l'utilisation d'un filtre élaboré (ou avancé) répondrait bien mieux à ta demande...

Maintenant, sans voir la structure exacte de ton fichier, (avec les noms des titres, plus quelques données "bidon"), ça va pas être simple de t'aider au mieux....

Donc, et afin de t'apporter une réponse adaptée, il serait préférable que tu joignes un fichier exemple (en respectant les critères énoncés supra....)

Bon courage

Bonjour,

Merci de ce premier retour.

Le filtre élaboré ne me permet pas à ma connaissance de spliter et d'enregistrer les fichiers découpés en fonction d'une colonne de référence.

Un exemple en pièce jointe pour vous donner plus de détails.

A bientôt.

Bonjour,

Si j'ai bien compris (car tu n'as toujours pas "clairement" signalé ce que tu désirais...)

Essaie ainsi :

Sub extract()
Dim Cel As Range, Plg As Range
Dim Derlig As Long
Dim Sh As Worksheet
Dim LePath As String
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
LePath = ThisWorkbook.Path & "\"
With Sheets("Feuil1")
    Derlig = .Cells(Rows.Count, "A").End(xlUp).Row
    Set Plg = .Range("A1:N" & Derlig)
    Plg(1).Resize(Derlig).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("P1"), Unique:=True
    For Each Cel In .Range("P2:P" & .Cells(Rows.Count, "P").End(xlUp).Row)
        If Cel <> "" Then
            .[P2] = Cel.Value
            Set Sh = Sheets.Add
            Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("P1:P2"), CopyToRange:=Sh.Range("A1")
            Sh.Move
            ActiveWorkbook.SaveAs Filename:=LePath & "Fournisseur " & Cel.Value & ".xls", FileFormat:=xlExcel8
            ActiveWorkbook.Close
        End If
    Next Cel
    .Columns("P:P").Clear
End With
Application.DisplayAlerts = True
End Sub

Bon courage

Bonjour et merci,

On y est presque sauf que la macro recopie des éléments dans les colonnes "I" et "J".

En pièce jointe le fichier "Fournisseur 2" réalisé avec votre macro et le même fichier nommé "Fournisseur 2 cible" pour vous donner une idée de ce que je souhaite réaliser.

En complément, quels paramètres dois-je modifier si demain, la colonne de référence n'est plus la 1 mais la 3 par exemple ?

Cdlt.

Bonsoir,

strato56 a écrit :

Bonjour et merci,

On y est presque sauf que la macro recopie des éléments dans les colonnes "I" et "J".......

Euh, dans le code que tu avais mis, il n'était nullement question de ces colonnes...

Et si tu as d'autres doléances, faut le dire de suite, les fils à étagères, c'est pas ce que je préfère...(style, j'ai oublié d'ajouter une condition....)

Si tu ne veux donc extraire que les données des colonnes A à F, il suffit de dimensionner Plg comme ceci :

...
...
Set Plg = .Range("A1:F" & Derlig)
...
...

Et si tu veux la colonne 3, par exemple, il suffit de modifier cette ligne :

Plg(3).Resize(Derlig).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("P1"), Unique:=True

Soit, remplacer le 1, par 3...

Bonne soirée

Bonsoir,

Mon premier post est plutôt explicite d'autant plus que je fais état des 14 colonnes qui vont de A à N.

En ce qui concerne l'export, ta macro fonctionne sauf que ça me copie deux fois l'adresse sur la même ligne (cf. mon fichier issu de ta macro "Fournisseur 2") alors que ce que je souhaite obtenir figure dans le fichier Fournisseur 2 cible".

Merci pour ta participation.

Bonsoir,

strato56 a écrit :

Bonsoir,

Mon premier post est plutôt explicite d'autant plus que je fais état des 14 colonnes qui vont de A à N.

En ce qui concerne l'export, ta macro fonctionne sauf que ça me copie deux fois l'adresse sur la même ligne (cf. mon fichier issu de ta macro "Fournisseur 2") alors que ce que je souhaite obtenir figure dans le fichier Fournisseur 2 cible".

Merci pour ta participation.

D'accord, tu as raison....

Bon courage

Edit,

Et effectivement, dans ton premier post, tu demandes à ce que les colonnes I et J ne soient pas dupliquées....

C'est vrai, mais je ne l'avais pas vu....

Nan, je déconne....

Tu estimes que ton 1er post est explicite???????

Edit 2

Afin que tu n'aies pas les I et J de dupliquées, il suffit de modifier le titre des ces colonnes, et de les nommer, par exemple, "Adresse2", et "Code postal2", et tout fonctionnera...

Bonne soirée

Je ne suis pas convaincu que les commentaires sarcastiques apportent quelques choses à la résolution d'une question posée.

Néanmoins, l'exemple du fichier de sortie laisse peu de place au doute même si ma question te semble peu claire.

Le nommage des colonnes doit rester tel que puisque les données issues de ce découpage doivent rejoindre une base Access une fois les colonnes "G" à "N" complétées par chacun des fournisseurs.

Ok,

J'ai essayé de t'aider...

Effectivement, après examen de ton fichier (venu bien plus tard), et analyse des résultats obtenus, j'admets que mon code n'est pas optimisé pour ton fichier...

Donc, je te prie de bien vouloir m'excuser d'avoir essayé de t'aider...

Tu ne verras donc plus mon nom dans un de tes fils, ainsi tu seras soulagé...

PS, dans le temps, j'avais une autre citation, que j'adorais, et que maintenant, grâce à toi, je vais peut-être remettre dans ma signature :

" il m'arrive d'envier les gens heureux, perclus de certitudes et sans doute aucun"

Au revoir