Copier/coller selon un critère

[kiff77]

Bonjour à tous,

Je sollicite vos services pour l'amélioration de ma macro.
Dans le fichier ci joint j'ai 5 onglets:
- Table ==> permet d'afficher le secteur par rapport au groupe
- BDD
- FS/CIPS/TS/Non cadre ==> accueil les données de l'onglet BDD. Pour les onglets FS/CIPS/TS l'extract doit se faire par rapport à la colonne F de l'onglet BDD alors que pour l'onglet non cadre l'extract doit se faire par rapport à la colonne E de l'onglet BDD.

Dans mon vrai fichier j'ai évidement plus d'onglet "d'accueil" (45).

Voici un bout de ma macro:

Range("A2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:="FS"
Range("A2:F49").Select
Selection.Copy
Sheets("FS").Select
Range("A4").Select
ActiveSheet.Paste

J'ai donc 4 fois ce bout de macro dans mon fichier.

Est il possible d'avoir une macro qui effectue le même travail sur tous les onglets situés à droite de l'onglet BDD (il ne faut pas touché à l'onglet table)?

Merci d'avance pour vos réponses
A+
Kiff

 

[skoobi]

Re : Copier/coller selon un critère

Bonjour,

voicic une proposition:

Sub extract()
  Application.ScreenUpdating = False
'la boucle suivante traite les feuille depuis la 3e jusqu'a l'avant dernière
  For i = 3 To Sheets.Count - 1
    Range("F2").AutoFilter Field:=6, Criteria1:=Sheets(i).Name
    Range("A2").CurrentRegion.Copy Sheets(i).Range("A4")
  Next
'traitement de la dernière feuille
  Range("F2").AutoFilter Field:=6
  Range("E2").AutoFilter Field:=5, Criteria1:="Non Cadre"
  Range("A2").CurrentRegion.Copy Sheets("Non Cadre").Range("A4")
  ActiveSheet.ShowAllData
  Application.ScreenUpdating = True
End Sub

Tu remarquera au passage la suppression des lignes avec .Select qui rallonge la macro et son temps d'exécution 😉

 

[pierrejean]

Re : Copier/coller selon un critère

bonjour Kiff

Vois si cela te convient

Note: Il n'y a pas de Non Cadre dans la colonne 6

Edit: Salut Skoobi 🙂
Avais pas rafraichi !!

 

[kiff77]

Re : Copier/coller selon un critère

Bonjour,

Merci à tous les deux pour vos réponses.
Je vais tester vos réponses sur mon vrai fichier.

Pierrejean, je me suis peut être mal exprimé mais je veux remplir les onglets FS/CIPS/TS selon les valeurs de la colonne F de l'onglet BDD et remplir l'onglet non cadre selon les valeurs de la colonne E.

Je vous tiens aux news
Encore merci
A+
Kiff

 

[pierrejean]

Re : Copier/coller selon un critère

Re

Version avec Non Cadre
Nb: par rapport a la version Skoobi le remplissage se fait sur toutes les feuilles a l'exception de BD et Table quelle que soit leurs positions (ce qui d'ailleurs n'est pas necessairement la meilleure methode)

 

[kiff77]

Re : Copier/coller selon un critère

Re,

ça marche nickel (en plus le temps de réponse est plus que satisfaisant).

Encore merci à vous deux
A+
Kiff