Tableau - Extraction : méthode resize après filtre et avec choix colonnes

[Olya]

Bonjour à Tous

Tout est dans le titre ou presque

je souhaite extraire les lignes visibles après filtre ( mais pas seulement). le tableau étant grand je veux prendre que quelques colonnes qui ne se suivent pas forcement et envoyer le résultat à destination d'un nouveau classeur nommé avec texte et horodatage : "toto_aaaammjjmmss"

PS. dans la pièce jointe l'extraction est faite vers Feuil2 et sans prendre en compte uniquement les lignes visibles

Merci de m'aider à solutionner le problème et si possible vers un autre classeur comme indiqué ci-dessus.

Cordialement

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Bonjour Olya, JM, le forum,

Avec ma méthode Copy il n'y a pas besoin d'utiliser SpecialCells(xlCellTypeVisible), Excel ne copie que les cellules visibles.

Les formats des cellules sont copiés mais pas les largeurs des colonnes ni les hauteurs de lignes, mais on peut y remédier.

Je vais modifier ma macro pour prendre en compte tous vos desiderata.

A+

 

[Olya]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re Job, Tous ..

Merci pour ta précision " Avec ma méthode Copy il n'y a pas besoin d'utiliser SpecialCells(xlCellTypeVisible), "
Le but étant de stocker les lignes visibles dans t (tableau virtuel). je ferai des tests avec copy en espérant que cela fonctionne

Sinon, à partir de ta Macro j'ai essayé de répondre à une partie de mes questions en arrivant à ceci, merci de jeter un coup d'œil et voir si on peut y apporter des corrections /optimisations ( grand merci d'avance).

 Sub Extract_Essai()
 'Copie colonnes et choix enregistrement
 Dim chemin$, nom$, colonnes As Range, P As Range, NomFichier As String
 Dim MyWb As Workbook: Set MyWb = ThisWorkbook
'
 nom = Environ("username") & "_" & Format(Now, "yyyymmdd_hhmmss")
 'Lecteur et dossier sources
 ChDrive (ThisWorkbook.Path): ChDir (ThisWorkbook.Path)
 
 Set col = Feuil1.[B:B,C:C,D:D,M:M,DR:DR] 'colonnes à adapter
 Set P = Intersect(Feuil1.[B25].CurrentRegion.EntireRow, col)
 
 Application.ScreenUpdating = False
 With Workbooks.Add(xlWBATWorksheet) 'nouveau document
  .Sheets(1).Name = nom
  P.Copy
    .Sheets(1).[B15].PasteSpecial Paste:=xlPasteColumnWidths
    .Sheets(1).[B15].PasteSpecial Paste:=xlPasteAll
'---------
'on ouvre le dialogue avec nom  fichier par défaut
    Application.DisplayAlerts = False
    NomFichier = Application.Dialogs(xlDialogSaveAs).Show(nom)
     If (NomFichier <> False) Then
     'on enregistre
     ActiveWorkbook.SaveAs Filename:=nom
     ActiveWorkbook.Close False
     '
     MsgBox "c'est ok.", vbOKOnly + vbInformation, "Information"
    End If
    Application.DisplayAlerts = True
 End With
 MyWb.Activate
 End Sub

Cordialement Olya

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re,

La macro devient assez conséquente :

Sub Extract()
Dim t$, col As Range, P As Range, ncol%, chemin$, nom$, nomfeuil$, ext$
Do
  t = InputBox("Lettres des colonnes séparées par un espace :", _
    "Choix des colonnes")
  If t = "" Then Exit Sub
  t = Replace(Application.Trim(t), " ", "1,") & 1
  On Error Resume Next
  Set col = Evaluate(t)
  On Error GoTo 0
Loop While col Is Nothing
Set col = col.EntireColumn
Set P = Feuil1.[B25].CurrentRegion.EntireRow
Application.ScreenUpdating = False
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
  P.Copy .[A1] '1ère copie pour la hauteur des lignes
  .Cells.Clear 'RAZ
  Intersect(P, col).Copy .[A1] '2ème copie, la bonne
  For Each col In col 'copie la largeur des colonnes
    ncol = ncol + 1
    .Columns(ncol).ColumnWidth = col.ColumnWidth
  Next
  ChDir ThisWorkbook.Path 'répertoire courant
  Application.Dialogs(xlDialogSaveAs).Show 'enregistrement choisi
  chemin = .Parent.Path
  If chemin = "" Then Exit Sub 'abandon
  nom = .Parent.Name
  nomfeuil = Left(nom, InStrRev(nom, ".") - 1)
  ext = Mid(nom, InStrRev(nom, "."))
  .Name = nomfeuil 'renomme la feuille
  .Parent.Close True
End With
Name chemin & "\" & nom As chemin & "\" & nomfeuil & _
  Format(Now, "_yyyymmdd_hhmmss") & ext 'renomme le fichier
Application.ScreenUpdating = True
MsgBox "Opération effectuée", , "Extraction"
End Sub

A+

 

[Staple1600]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re


Olya
Donc finalement mes suggestions t'ont servi, on dirait
car dans ton code, on retrouve:
Application.Dialogs(xlDialogSaveAs).Show
Et je vois un InputBox dans le code de job75.

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re JM,

Tu crois vraiment que j'avais besoin de ton aide ?

A+

 

[Staple1600]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re

Job75
Je m'adressais à Olya bien évidemment, non ?
(puisque c'est son pseudo et lui seul que j'ai mis en gras dans mon précédent message)
J'indiquais juste que les mots-clés suggérés dans le message #13 sont bien utilisés dans les codes VBA des messages ultérieurs.
Ce qui à mon sens infirme ceci

Merci pour ton temps mais tes Suggestions matinales ne m'aident pas beaucoup ...

 

[Olya]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re


Olya
Donc finalement mes suggestions t'ont servi, on dirait
car dans ton code, on retrouve:
Application.Dialogs(xlDialogSaveAs).Show
Et je vois un InputBox dans le code de job75.

Merci Staple mais je n'avais pas encore cliquer sur tes liens .. les dites fonctions je les connaissais.. et job certainement aussi
mais il s'agit comme je le disais de quelques lacunes d'optimisations et de connaissances générales (j'ai cherché et je cherche toujours) ..mais je cherche à m'améliorer au contacts des meilleurs ( qui a dit que les femmes n'aiment pas le contact?)
c'est une bonne occasion aussi de connaître et dialoguer avec les gens ici.
--

Job merci pour ton code ..dans le mien il manquait la gestion du choix de colonnes ( en fonction de la structure de la macro), car bien que connaissant inputbox je n'aurai pas su l'idée d'utiliser ça sans la souris ..( beau travail)+trim+evaluté ( j'apprend au passage).

Edit: merci pour la copie de la hauteur des lignes un vrai + pour moi (cool)
Très cordialement

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re,

J'ai testé la macro du post #18 sur 125 000 lignes avec filtrage de la colonne C sur "comm B".

A cause de la 1ère copie la durée d'exécution est de 27 secondes.

En ne copiant que la 1ère ligne (en-têtes) la durée est de 8 secondes :

Sub Extract()
Dim t$, col As Range, P As Range, ncol%, chemin$, nom$, nomfeuil$, ext$
Do
  t = InputBox("Lettres des colonnes séparées par un espace :", _
    "Choix des colonnes")
  If t = "" Then Exit Sub
  t = Replace(Application.Trim(t), " ", "1,") & 1
  On Error Resume Next
  Set col = Evaluate(t)
  On Error GoTo 0
Loop While col Is Nothing
Set col = col.EntireColumn
Set P = Feuil1.[B25].CurrentRegion.EntireRow
Application.ScreenUpdating = False
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
  .Rows(1).RowHeight = P.Rows(1).RowHeight 'copie la hauteur de la ligne d'en-têtes
  Intersect(P, col).Copy .[A1] 'copie des cellules visibles
  For Each col In col 'copie la largeur des colonnes
    ncol = ncol + 1
    .Columns(ncol).ColumnWidth = col.ColumnWidth
  Next
  ChDir ThisWorkbook.Path 'répertoire courant
  Application.Dialogs(xlDialogSaveAs).Show 'enregistrement choisi
  chemin = .Parent.Path
  If chemin = "" Then Exit Sub 'abandon
  nom = .Parent.Name
  nomfeuil = Left(nom, InStrRev(nom, ".") - 1)
  ext = Mid(nom, InStrRev(nom, "."))
  .Name = nomfeuil 'renomme la feuille
  .Parent.Close True
End With
Name chemin & "\" & nom As chemin & "\" & nomfeuil & _
  Format(Now, "_yyyymmdd_hhmmss") & ext 'renomme le fichier
Application.ScreenUpdating = True
MsgBox "Opération effectuée", , "Extraction"
End Sub

A+

 

[Olya]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re job

En effet, La macro gagne en rapidité avec ta dernière retouche.
je suis arrivée à la même conclusion que toi sauf que ( après test) pour conserver la hauteur sur l'ensemble des lignes et pas uniquement à la ligne 1 j'ai modifié ainsi:

J'ai remplacé ça:
P.Rows(1).Copy .[A1] 'copie pour la hauteur de la ligne d'en-têtes
.Rows(1).Clear 'RAZ

Par:
'P.Rows .Copy .[A1] 'copie pour la hauteur de la ligne d'en-têtes
'.Rows.Clear 'RAZ

Encore Merci infiniment champion

Cordialement Olya

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re,

Votre modification ne change rien à mon code : toutes les cellules sont copiées, pas seulement les hauteurs de lignes.

On peut faire tout simplement pour une ligne :

.Rows(1).RowHeight = P.Rows(1).RowHeight 'copie la hauteur de la ligne d'en-têtes

Je modifie la macro du post #23.

A+

 

[Olya]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re_job

Ta macro est parfaite et ton aide est précieuse ..
je m'explique :
dans ta macro la hauteur de la ligne d'entête est effectivement préservée ( et cela avant et même après ta dernière modification).
mais ça ne préserve pas la hauteur de la ligne 28 ou 30 par exemple ( essaye de modifier la hauteur de ton fichier source à 40 par exemple et ensuite exécute la marco .. ( tu remarqueras que la hauteur des lignes en dessous n'est pas préservée).

mais le fait d'écrire (dans le code) Rows sans le (1) dans les deux lignes en question permet de tout préserver. (c'est ce que je voulais).

Cordialement Olya

 

[job75]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Re,

Comprenette difficile ? Comme je l'ai dit votre code fait strictement la même chose que ce ce que fait ma macro du post #18 :

P.Copy .[A1] '1ère copie pour la hauteur des lignes
.Cells.Clear 'RAZ

Vos .Rows ne servent à rien.

Au post #18 on copie toutes les lignes avec leur hauteur, au post #23 seulement la ligne 1.

A+

 

[Olya]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

RE

Job en effet c'est juste eu égard le poste 18 , je n'étais pas remonté jusqu'au là

autant pour moi
A bientôt

 

[gosselien]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Bonjour à tous,

pour ma part, je me demande si c'est vraiment le but d'excel de gérer autant de lignes ?
n'est ce pas réservé à Access ?

Ceci dit la rapidité du code de JOB75 est sidérante
encore faut il le pc qui suive, car beaucoup de gens travaillent (comme moi) encore avec XP-Xl2003 (voire 2007 de plus en plus) 2 Gg de ram et un processeur à 2Ghz...

ps: je plussoie aussi le commentaire de "HERDET" que j'ai connu sur MPFE au bon vieux temps avec Misange (excelabo), Alain Vallon, Laurent Longre, Denis Michon , ChrisV,JPS et d'autres qui sévissent encore sur ce forum passé sur google, malheureusement moi le n'ai plus suivi et donc pas bcp progressé mais je reste admiratif des "king" de ce forum et leur réponse souvent très bien tapées

 

[Herdet]

Re : Tableau - Extraction : méthode resize après filtre et avec choix colonnes

Bonjour à tous,
...
ps: je plussoie aussi le commentaire de "HERDET" que j'ai connu sur MPFE au bon vieux temps avec Misange (excelabo), Alain Vallon, Laurent Longre, Denis Michon , ChrisV,JPS et d'autres qui sévissent encore sur ce forum passé sur google, malheureusement moi le n'ai plus suivi et donc pas bcp progressé mais je reste admiratif des "king" de ce forum et leur réponse souvent très bien tapées

Bonsoir gosselien,
[HS] Un instant de nostalgie !
J'ai gardé beaucoup de très bons souvenirs du MPFE (15 ans déjà !), de l'excellente ambiance qu'il y régnait grâce à des contributeurs de talent en Excel et VBA, quelques "animateurs" super doués en HS et des franches rigolades.
Sans oublier les rencontres annuelles et parfois plus fréquentes où il y avait de 20 à 40 participants en France et Belgique avec des soirées dansantes, chantantes, un peu déjantées au resto, en boite et des visites diverses de caves à vin, bergeries, vignobles, grottes, dans des villes assez variées comme Paris, Marseille, Liège, Sancerre, Saulieu,...
Un grand merci à Misange pour avoir conservé sur Bienvenue sur Excelabo | www.excelabo.net la trace d'une bonne partie de ces sympathiques échanges
... et pour les débutants en auraient besoin pour découvrir Excel Ce lien n'existe plus

Cordialement
Robert