Export après filtre (vba)

Le
j-pascal
Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les données
relatives à chaque fournisseur vers un classeur spécifique.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaque
fournisseur vers un classeur renommé avec le nom du fournisseur situé
dans la colonne "C" et le tout dans un répertoire dédié

Etant donné que certaines cellules sont des formules liées (), il
faut probablement que l'export recopie les "valeurs" (collage
spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Corto
Le #19167801
Bonjour j-pascal,
J'ai une macro qui éclate une liste d'articles avec une page par
fournisseur, je ne pense pas qu'il y ait beaucoup à adapter pour ton ca s.
Sub EclateParFournisseurs()
Set XHEAD = [A1].CurrentRegion.Rows(1)
Set XZONE = [A1].CurrentRegion.Offset(1,
0).Resize(RowSize:=[A1].CurrentRegion.Rows.Count - 1)
On Error Resume Next
For Each XROW In XZONE.Rows
Set XSH = Sheets(XROW.Cells(3).Text)
If XSH Is Nothing Then
Set XSH = ThisWorkbook.Worksheets.Add
XSH.Name = XROW.Cells(3).Text
XHEAD.Copy Destination:=XSH.Cells(1)
End If

XSH.Cells(1).CurrentRegion.Rows(XSH.Cells(1).CurrentRegion.Rows.Count +
1).Cells(1). _
PasteSpecial Paste:=xlPasteValues
Set XSH = Nothing
Next XROW
End Sub

Corto

j-pascal a écrit :
Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les
données relatives à chaque fournisseur vers un classeur spécifiqu e.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaqu e
fournisseur vers un classeur renommé avec le nom du fournisseur situé
dans la colonne "C" et le tout dans un répertoire dédié ...

Etant donné que certaines cellules sont des formules liées (...), i l
faut probablement que l'export recopie les "valeurs" (collage
spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP




j-pascal
Le #19168061
Bonjour Fredo,

Merci pour cette proposition. Pour l'instant, je n'arrive pas à
l'adapter à mes besoins (me copie chaque fois une ligne dans un onglet
différent bien que la référence du fournisseur soit plusieurs fois
identique ...)

JP

Bonjour j-pascal,
J'ai une macro qui éclate une liste d'articles avec une page par fournisseur,
je ne pense pas qu'il y ait beaucoup à adapter pour ton cas.
Sub EclateParFournisseurs()
Set XHEAD = [A1].CurrentRegion.Rows(1)
Set XZONE = [A1].CurrentRegion.Offset(1,
0).Resize(RowSize:=[A1].CurrentRegion.Rows.Count - 1)
On Error Resume Next
For Each XROW In XZONE.Rows
Set XSH = Sheets(XROW.Cells(3).Text)
If XSH Is Nothing Then
Set XSH = ThisWorkbook.Worksheets.Add
XSH.Name = XROW.Cells(3).Text
XHEAD.Copy Destination:=XSH.Cells(1)
End If
XSH.Cells(1).CurrentRegion.Rows(XSH.Cells(1).CurrentRegion.Rows.Count
+ 1).Cells(1). _
PasteSpecial Paste:=xlPasteValues
Set XSH = Nothing
Next XROW
End Sub

Corto

j-pascal a écrit :
Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les données
relatives à chaque fournisseur vers un classeur spécifique.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaque
fournisseur vers un classeur renommé avec le nom du fournisseur situé dans
la colonne "C" et le tout dans un répertoire dédié ...

Etant donné que certaines cellules sont des formules liées (...), il faut
probablement que l'export recopie les "valeurs" (collage spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP




j-pascal
Le #19168041
> Bonjour J-Pascal,

À partir des codes fournisseurs, y a-t-il moyen
d'identifier le nom du classeur où tu veux copier les données?



Il s'agit d'effectuer des relances, donc un nouveau classeur sera créé
pour la circonstance.

Je résume mon tableau initial :

Ligne 15 : les titres (au dessus, il y a des infos récurentes)
Lignes 16 à 500 (environ) : le tableau général
Colonne B : les codes correspondant aux fournisseurs (parfois un seul,
parfois 5 ou 6)
J'aimerais qqch qui balaye cette colonne (à partir de la ligne 16) et
qui me recopie les lignes (entières) correspondant au code fournisseur
trouvé dans un classeur spécifique à chaque fournisseur trouvé.
Si possible, il faudrait que le classeur soit renommé au nom du
fournisseur trouvé dans la colonne B. Et si possible, il faudrait que
tous les classeurs ainsi créés soient mis dans un nouveau répertoire.

Est-ce que les classeurs des fournisseurs sont tous dans le même répertoire?
Si oui quel est le chemin... sinon comment faire par macro pour trouver
ce chemin afin des ouvrir le cas échéant?

Les données à copier dans les fichiers des fournisseurs sont-ils copiés dans
la même feuille (même nom) pour chacun des fichiers? Sinon, comment faire
par macro pour identifier le nom de la feuille pour chacun des fichiers?

Le filtre que tu exécutes se fait sur quelle colonne de ta plage de données?
Ton tableau des données a quelle étendue? Il est situé dans quelle feuille
(son nom)?



A vrai dire, je pense que le filtre est inutile ; je pense plutôt à un
macro qui balayerait la colonne B de la ligne 16 à 500 (ie)

Pour faire une macro, il faut avoir une information précise de ton
environnement de travail !



"j-pascal" discussion : Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les données
relatives à chaque fournisseur vers un classeur spécifique.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaque
fournisseur vers un classeur renommé avec le nom du fournisseur situé
dans la colonne "C" et le tout dans un répertoire dédié ...

Etant donné que certaines cellules sont des formules liées (...), il
faut probablement que l'export recopie les "valeurs" (collage
spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP


j-pascal
Le #19168391
Ouahhh ! Le résultat est INCROYABLE !

Merci ++

En fait, il faudrait que ce qui est "Feuille" soit "Classeur"
(Un classeur pour chaque fournisseur)
et que tous les classeurs créés (depuis le filtre) soient regroupés
dans un répertoire (nommé avec la date du jour par exemple).

Par ailleurs, les données qui figurent sur la feuille principale de la
ligne 1 à 15 doivent être copiées dans les classeurs (feuilles) de
destination ...

Je suis déjà très impressionné par le résultat de ta présente
proposition. Encore merci !

JP

Place cette procédure dans un module standard :
et renseigne le nom de la feuille dans la procédure
où sont tes données actuelles.

Une feuille pour chaque code fournisseurs sera créé
en son nom et les données correspondantes y seront copiées

'------------------------------------------------------------
Sub Filtre()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet

Application.ScreenUpdating = False

With Worksheets("Feuil1") 'Nom Feuille à adapter
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With

Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With

With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible) _
.EntireRow.Copy Sh1.Range("A1")
End With
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'------------------------------------------------------------




"j-pascal" discussion :
Bonjour J-Pascal,

À partir des codes fournisseurs, y a-t-il moyen
d'identifier le nom du classeur où tu veux copier les données?



Il s'agit d'effectuer des relances, donc un nouveau classeur sera créé
pour la circonstance.

Je résume mon tableau initial :

Ligne 15 : les titres (au dessus, il y a des infos récurentes)
Lignes 16 à 500 (environ) : le tableau général
Colonne B : les codes correspondant aux fournisseurs (parfois un seul,
parfois 5 ou 6)
J'aimerais qqch qui balaye cette colonne (à partir de la ligne 16) et
qui me recopie les lignes (entières) correspondant au code fournisseur
trouvé dans un classeur spécifique à chaque fournisseur trouvé.
Si possible, il faudrait que le classeur soit renommé au nom du
fournisseur trouvé dans la colonne B. Et si possible, il faudrait que
tous les classeurs ainsi créés soient mis dans un nouveau répertoire.

Est-ce que les classeurs des fournisseurs sont tous dans le même répertoire?
Si oui quel est le chemin... sinon comment faire par macro pour trouver
ce chemin afin des ouvrir le cas échéant?

Les données à copier dans les fichiers des fournisseurs sont-ils copiés dans
la même feuille (même nom) pour chacun des fichiers? Sinon, comment faire
par macro pour identifier le nom de la feuille pour chacun des fichiers?

Le filtre que tu exécutes se fait sur quelle colonne de ta plage de données?
Ton tableau des données a quelle étendue? Il est situé dans quelle feuille
(son nom)?



A vrai dire, je pense que le filtre est inutile ; je pense plutôt à un
macro qui balayerait la colonne B de la ligne 16 à 500 (ie)

Pour faire une macro, il faut avoir une information précise de ton
environnement de travail !



"j-pascal" discussion : Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les données
relatives à chaque fournisseur vers un classeur spécifique.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaque
fournisseur vers un classeur renommé avec le nom du fournisseur situé
dans la colonne "C" et le tout dans un répertoire dédié ...

Etant donné que certaines cellules sont des formules liées (...), il
faut probablement que l'export recopie les "valeurs" (collage
spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP




j-pascal
Le #19177551
Bonsoir Michel,

Je suis vraiment très impressionné !!

Après quelques menues adaptations, le résultat est à peine croyable !

Depuis hier soir, j'essayais "désespérément" d'adapter ton précédent
code, en vain !


1 -

Je vais renoncer à recopier les 15 lignes du haut du tableau car je
pense que le jeu n'en vaut pas la chandelle. Par contre, les nouvelles
feuilles exportées ont des largeurs de colonnes égales.


Dois-je insérer :
'------
Cells.Select
Cells.EntireColumn.AutoFit
'------

dans :

'------
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sh1.Range("A1")
'---
ici !
'---
End With
'------


2 -

Si je relance la macro alors que le répertoire existe déjà, j'ai une
fenêtre de débogage qui s'ouvre sur "MkDir Chemin" :

'-----
Chemin = Chemin & Format(Now, "yyyy-mm-dd")
MkDir Chemin
'-----

Est-ce qu'un test du genre :

'-----
If MkDir Chemin < > 0 then
Exit Sub
Else
MkDir Chemin
'-----

peut faire l'affaire ?


Un très grand MERCI pour l'aide considérable que tu viens de m'apporter
par ce présent code. Il faut maintenant que je décortique le tout et
que je me familiarise avec le code des filtres.

JP



Tu dois adapter 1 chose dans la procédure :

A ) le chemin où seront enregistrés tes fichiers

'--------------------------------------------
Sub Filtre()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String

Chemin = "c:UsersDMDocuments" 'à modifier

If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy mm dd H MM SS")
MkDir Chemin

Application.ScreenUpdating = False

With Worksheets("Feuil1") 'Nom Feuille à adapter
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With

Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With

With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible) _
.EntireRow.Copy Sh1.Range("A1")
End With
Sh1.Copy
With ActiveWorkbook
'modifier l'extension de fichier si nécessaire
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsm"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'--------------------------------------------


"j-pascal" discussion : Ouahhh ! Le résultat est
INCROYABLE !

Merci ++

En fait, il faudrait que ce qui est "Feuille" soit "Classeur"
(Un classeur pour chaque fournisseur)
et que tous les classeurs créés (depuis le filtre) soient regroupés
dans un répertoire (nommé avec la date du jour par exemple).

Par ailleurs, les données qui figurent sur la feuille principale de la
ligne 1 à 15 doivent être copiées dans les classeurs (feuilles) de
destination ...

Je suis déjà très impressionné par le résultat de ta présente
proposition. Encore merci !

JP

Place cette procédure dans un module standard :
et renseigne le nom de la feuille dans la procédure
où sont tes données actuelles.

Une feuille pour chaque code fournisseurs sera créé
en son nom et les données correspondantes y seront copiées

'------------------------------------------------------------
Sub Filtre()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet

Application.ScreenUpdating = False

With Worksheets("Feuil1") 'Nom Feuille à adapter
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With

Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With

With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With

For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible) _
.EntireRow.Copy Sh1.Range("A1")
End With
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'------------------------------------------------------------




"j-pascal" discussion :
Bonjour J-Pascal,

À partir des codes fournisseurs, y a-t-il moyen
d'identifier le nom du classeur où tu veux copier les données?



Il s'agit d'effectuer des relances, donc un nouveau classeur sera créé
pour la circonstance.

Je résume mon tableau initial :

Ligne 15 : les titres (au dessus, il y a des infos récurentes)
Lignes 16 à 500 (environ) : le tableau général
Colonne B : les codes correspondant aux fournisseurs (parfois un seul,
parfois 5 ou 6)
J'aimerais qqch qui balaye cette colonne (à partir de la ligne 16) et
qui me recopie les lignes (entières) correspondant au code fournisseur
trouvé dans un classeur spécifique à chaque fournisseur trouvé.
Si possible, il faudrait que le classeur soit renommé au nom du
fournisseur trouvé dans la colonne B. Et si possible, il faudrait que
tous les classeurs ainsi créés soient mis dans un nouveau répertoire.

Est-ce que les classeurs des fournisseurs sont tous dans le même
répertoire? Si oui quel est le chemin... sinon comment faire par macro pour
trouver ce chemin afin des ouvrir le cas échéant?

Les données à copier dans les fichiers des fournisseurs sont-ils copiés
dans la même feuille (même nom) pour chacun des fichiers? Sinon, comment
faire par macro pour identifier le nom de la feuille pour chacun des
fichiers?

Le filtre que tu exécutes se fait sur quelle colonne de ta plage de
données? Ton tableau des données a quelle étendue? Il est situé dans quelle
feuille (son nom)?



A vrai dire, je pense que le filtre est inutile ; je pense plutôt à un
macro qui balayerait la colonne B de la ligne 16 à 500 (ie)

Pour faire une macro, il faut avoir une information précise de ton
environnement de travail !



"j-pascal" discussion : Bonjour,

Dans la colonne "C" (ie), j'ai plusieurs codes de fournisseurs.
J'ai un filtre qui permet de les sélectionner et d'exporter les données
relatives à chaque fournisseur vers un classeur spécifique.

Comment puis-je faire la même manip avec une macro ?

L'idéal serait de pouvoir exporter les lignes spécifiques à chaque
fournisseur vers un classeur renommé avec le nom du fournisseur situé
dans la colonne "C" et le tout dans un répertoire dédié ...

Etant donné que certaines cellules sont des formules liées (...), il
faut probablement que l'export recopie les "valeurs" (collage
spécial/valeurs).

A noter que je dois conserver le haut du tableau (10 lignes environ)

Merci pour vos lumières,

JP






j-pascal
Le #19178101
Vraiment merci. Ceci va au delà de mes espérances !

Question subsidiaire :

Pourquoi, lorsque j'ajoute des "-" à la date, ça fonctionne :

Format(Now, "yyyy-mm-dd H MM SS")

Alors que si j'ajoute des ":" aux heures, ça ne fonctionne pas :

Format(Now, "yyyy mm dd H:MM:SS")

J'imagine qu'il faut concaténer les heures, minutes et secondes avec
des "" et des &.

?

JP

1 -
Je vais renoncer à recopier les 15 lignes du haut du tableau car je
pense que le jeu n'en vaut pas la chandelle. Par contre, les nouvelles
feuilles exportées ont des largeurs de colonnes égales.
Ce que tu dois insérer :
'------
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit

dans :

'------
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sh1.Range("A1")
'---
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
'---
End With
'------


2 -
Si je relance la macro alors que le répertoire existe déjà, j'ai une
fenêtre de débogage qui s'ouvre sur "MkDir Chemin" :



Chemin = Chemin & Format(Now, "yyyy-mm-dd")
MkDir Chemin



*** Ce que je t'avais proposé c'est ceci: le format date
inclus Heure minute et seconde, donc impossible
de créer 2 répertoires ayant le même nom. C'était la raison
d'être d'insérer "l"heure"

Chemin = Chemin & Format(Now, "yyyy mm dd H MM SS")
MkDir Chemin


j-pascal
Le #19181361
Merci.
Je n'avais pas fait le rapprochement ! Suis-je bête ?! (stp, ne réponds
pas à cette dernière question ;-) )

Dans le nom d'un répertoire, il y a des caractères interdits d'usage.

Ces caractères sont : "*" , "?" , "<" , ">" , "" , "/" ":" , "|"




"j-pascal" discussion : Vraiment merci. Ceci va
au delà de mes espérances !

Question subsidiaire :

Pourquoi, lorsque j'ajoute des "-" à la date, ça fonctionne :

Format(Now, "yyyy-mm-dd H MM SS")

Alors que si j'ajoute des ":" aux heures, ça ne fonctionne pas :

Format(Now, "yyyy mm dd H:MM:SS")

J'imagine qu'il faut concaténer les heures, minutes et secondes avec
des "" et des &.

?

JP

1 -
Je vais renoncer à recopier les 15 lignes du haut du tableau car je
pense que le jeu n'en vaut pas la chandelle. Par contre, les nouvelles
feuilles exportées ont des largeurs de colonnes égales.
Ce que tu dois insérer :
'------
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit

dans :

'------
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sh1.Range("A1")
'---
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
'---
End With
'------


2 -
Si je relance la macro alors que le répertoire existe déjà, j'ai une
fenêtre de débogage qui s'ouvre sur "MkDir Chemin" :
Chemin = Chemin & Format(Now, "yyyy-mm-dd")
MkDir Chemin



*** Ce que je t'avais proposé c'est ceci: le format date
inclus Heure minute et seconde, donc impossible
de créer 2 répertoires ayant le même nom. C'était la raison
d'être d'insérer "l"heure"

Chemin = Chemin & Format(Now, "yyyy mm dd H MM SS")
MkDir Chemin




Publicité
Poster une réponse
Anonyme