Aide pour une macro

[antoine04]

Bonjour,

je viens vers vous car j'ai besoin d'aide.

J'explique ce que je souhaite.
Je recherche à faire une extraction de donnée de ma feuille excel "Portefeuille Clients". Dans cette feuille, j'ai un statut pour chaque commande : Cdé, Annulé ou Expédié.
Je souhaite extraire toute les commandes Cdé, ainsi que toute les commandes Expédié durant les 7 derniers jours.
Tous cela doit ensuite être mis ensemble pour faire une unique feuille qui me servira de suivi.

J'ai créé la macro suivante, qui fonctionne, mais qui est très lente et surtout qui ne va pas au bout de ce que je souhaite. Elle crée deux feuilles avec les données que je recherche mais je ne sais pas regrouper ses deux feuilles en une unique.

J'ai donc deux questions :

- Comment faire ? (elle est rechercher comme question...)
- Avez-vous un système moins lourd que mon code ci-dessous, car il est très lent à exécuté.

Je reste évidemment à votre disposition pour toute question et je vous remercie d'avance pour votre aide à venir.

-------------------------------------------------

' Désactivation de l'affichage
Application.ScreenUpdating = False

' Copie des données
Sheets("Portefeuille Clients").Select
Cells.Select
Selection.Copy
Sheets("Extraction").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

' Filtre des données
Columns("A:BZ").Select
Selection.AutoFilter
Selection.AutoFilter Field:=46, Criteria1:="Expédié"
Selection.AutoFilter Field:=41, Criteria1:=">=" & Format(CDate(Now - 7), "mm/dd/yyyy")

' Colle dans une nouvelle feuille
Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste

' Encore
' Copie des données
Sheets("Portefeuille Clients").Select
Cells.Select
Selection.Copy
Sheets("Extraction").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

' Filtre des données
Columns("A:BZ").Select
Selection.AutoFilter
Selection.AutoFilter Field:=46, Criteria1:="Cdé"

' Colle dans une nouvelle feuille
Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste

' Je bloque...

' Activation de l'affichage
Application.ScreenUpdating = True

 

[pierrejean]

Re : Aide pour une macro

bonjour antoine04

Il nous serait bien plus facile de t'aider avec un petit fichier exemple (quelques lignes sans données confidentielles suffisent)

 

[antoine04]

Re : Aide pour une macro

Bonjour pierrejean,

j'étais justement entrain d'en faire un, je me suis dis que cela serai plus simple aussi.

Je rajoute que la macro est très longue car j'ai plus de 3 500 lignes de commandes, mais je pense que c'est possible de faire plus simple, mais là je deviens limité dans mes connaissances.

Voici le fichier

 

[Paritec]

Re : Aide pour une macro

Bonjour Antoine, Bonsoir Pierrejean,
je pense que des feuilles tu en auras assez a force!!!!
mais le but de ta macro faite avec l'enregistreur, c'est quoi de créer des feuilles ou de faire une feuille ?
Si c'est de faire une feuille explique un peu ce que tu souhaites retrouver dedans, et explique de quelle manière tu travailles avec ton fichier car tu veux extraire une fois par semaine OK mais après conserver une seule feuille donc effacer l'ancienne? ou ajouter les données filtrées en bout de ta feuille?
Voilà Pierrejean auras peut-être compris lui mais moi pas vraiment
a+
bonne soirée
papou

EDIT : ajoute une feuille ou tu mets les données telle que tu les souhaites dans une feuille nommée comme tu le veux Résultat ou extraction et après on saura t'aider

 

[antoine04]

Re : Aide pour une macro

Bonjour Paritec,

Tu trouvera le nouveau fichier joint à mon message.

Pour te répondre, je souhaite extraire toute les commandes Cdé, ainsi que toute les commandes Expédié durant les 7 derniers jours de la façon suivante.
Je lance l'extraction manuellement en appuyant sur le bouton.
J'aimerai que le résultat de ma requête soit sur une unique feuille avec les expédié au dessus et les Cdé en dessous.
A chaque fois que je lancerai la macro, je n'aurai plus besoin du résultat précédent, donc suppression de l'ancienne recherche et ajout de la nouvelle à la place.
Mon problème, c'est surtout de faire en sorte que cette recherche soit mise dans une unique feuille excel.

En espérant avoir été plus clair.

 

[pierrejean]

Re : Aide pour une macro

Re

Vois si cela te convient
Resultat en feuille Extraction (créee si elle n'existe pas et effacée en debut de macro si elle existe)

Edit: Si la vitesse est encore lente n'hesite pas a revenir on pourra peut-etre accelerer un peu

 

[antoine04]

Re : Aide pour une macro

Bonjour,

cela correspond à ce que je voulais, merci beaucoup pierrejean.

Je testerai sur mon fichier Lundi, je ne l'ai pas chez moi mais au travail.

Je te tiendrais évidemment au courant, merci encore.

 

[antoine04]

Re : Aide pour une macro

Bonjour,

Je viens de tester sur mon fichier, et cela est parfait, c'est ce que je souhaitais.
En revanche, cela reste lent, mais acceptable, la faute à mes 56 colonnes et nombreuses lignes.

Merci beaucoup.

Petite question HS :
Es-ce que tu sais comment faire pour être certain que chaque macro est terminé ? Car j'ai constaté que mon fichier est 2 fois moins volumineux depuis que j'ai mis ton code, et je ne sais pas pourquoi...

 

[Paritec]

Re : Aide pour une macro

Bonjour à tous,
oui tu rajoutes après la dernière ligne
a+
Papou

Sheets("Extraction").Range("A2:D" & S
msgbox "Opération terminée"
end sub

 

[pierrejean]

Re : Aide pour une macro

Re

teste cette version

Sub test()
debut = Timer
Application.ScreenUpdating = False
On Error Resume Next
 Set sh = Sheets("Extraction")
 If Err.Number <> 0 Then Sheets.Add.Name = "Extraction"
On Error GoTo 0
Sheets("Extraction").Cells.ClearContents
ligne = 3
Sheets("Feuil1").Range("A2:D2").Copy Destination:=Sheets("Extraction").Range("A2")
tableau = Sheets("Feuil1").Range("A2:D" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
For n = LBound(tableau, 1) To UBound(tableau, 1)
  If tableau(n, 4) = "Cdé" Or (tableau(n, 4) = "Expédié" And tableau(n, 3) >= Now - 7) Then
   For col = 1 To 4
    Sheets("Extraction").Cells(ligne, col) = tableau(n, col)
   Next col
    ligne = ligne + 1
  End If
Next n
Sheets("Extraction").Range("A2:D" & Sheets("Extraction").Range("A65536").End(xlUp).Row).Sort Key1:=Sheets("Extraction").Range("D3"), Order1:=xlDescending, Header:=xlGuess
Application.ScreenUpdating = True
MsgBox ("Terminé en " & Timer - debut & " seconde(s)")
End Sub

 

[antoine04]

Re : Aide pour une macro

Bonjour PierreJean,

J'avais testé en desactivant l'affichage, mais cela n'avait rien changé.
J'ai détecté le problème à l'instant, il y avait un conflit avec les filtres qui était ajouter sur la page Extraction par une autre de mes macro.
Maintenant, cela s'exécute entre 4 et 5 secondes (bonne idée le Timer ^^)

Je te remercie