Copier/coller d'un onglet vers un autre onglet suivant un critère

anthonyhk

XLDnaute Junior
Bonjour,

Sur l'onglet principal "extract" j'aimerai faire un copier/coller de la ligne suivant le critère Ville.
J'aimerai que le copier, colle la ligne en créant un onglet correspondant à chaque ville.

Exemple : si il y a les villes Gonesse, Stains, Paris 1 , Paris 13, la macro va copier les lignes correspondant au critère de la ville et coller ses lignes en créeant l'onglet (avec le nom de la ville).
L'onglet Gonesse aura les lignes du champ extract avec le critère ville Gonesse
L'onglet Paris 1 aura les lignes du champ extract avec le critère ville Paris 1
etc...

Pensez vous que c'est possible ou pas ?

Merci d'avance à vous.

:)
 

Pièces jointes

  • agenda HE_E.xls
    241 KB · Affichages: 62
  • agenda HE_E.xls
    241 KB · Affichages: 71
  • agenda HE_E.xls
    241 KB · Affichages: 79

titiborregan5

XLDnaute Accro
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour anthonyhk, le forum,

j'utilise dans ce cas le filtre élaboré!!! Il correspond parfaitement à ce que tu veux... Couplé à la copie d'un modèle et hop...

Dis-moi si tu as besoin d'un exemple plus détaillé!

A+
Tibo
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour Anthony, Titiborregan, bonjour le forum,

Essaie comme ça :

Code:
Sub Macro1()
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Sheets("extract") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet OS
Set PL = OS.Range("A11:A" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL.Offset(0, 7) 'boucle sur toutes les cellules CEL de la plage PL décalée de 7 colonne à droite (=colonne H)
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère la liste des données de la plage PL sans doublons dans le tableau temporaire TMP
For I = 0 To UBound(TMP) 'boucle sur tous les élément uniques du tableau temporaire TMP
    OS.Range("A10").AutoFilter Field:=8, Criteria1:=TMP(I) 'filtre la colonne 8 (=H) de l'onglet OS avec l'élément TMP(I) comme critère
    Set PLV = PL.Resize(, 9).SpecialCells(xlCellTypeVisible) 'définit la plage PLV (les éléments visibles (non filtrés) de la plage PL redimensionnés à 9 colonnes)
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante
    Set OD = Sheets(TMP(I)) 'définit l'onglet de destination OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        Sheets("Template").Copy after:=Sheets(Sheets.Count) 'copy l'onglet "Template"
        ActiveSheet.Name = TMP(I) 'renomme la copie de l'onglet
        Set OD = ActiveSheet 'définit l'onglet de destination OD
    End If 'fin de la condition
    On Error GoTo 0 'supprime la gestion des erreurs
    Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    PLV.Copy DEST 'copy la plage PLV et la colle dans DEST
    OS.Range("A10").AutoFilter 'supprime le filtre automatique
Next I 'prochain élément de la boucle
End Sub
 

titiborregan5

XLDnaute Accro
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Hello Robert,

un code avec le filtre avancé!!!
VB:
Sub filtre_elab()

With Sheets("extract")
.Range("L10") = .Range("H10") 'on recopie le titre de ce sur quoi on veut filtrer ici la ville
.Range("a10").CurrentRegion.AdvancedFilter xlFilterCopy, , .Range("L10"), True 'on indique toutes les villes sans doublon via un filtre élaboré

For i = 11 To .Range("L65000").End(xlUp).Row 'à partir de la liste des villes créée juste avant on fait une boucle pour chaque ville
ville = .Cells(i, 12) 'on se rappelle du nom de la ville pour après
Sheets("template").Copy after:=Sheets(Sheets.Count) 'on copie la feuille template en dernier
Sheets(Sheets.Count).Name = ville 'on la renomme avec le nom de ville
Sheets(ville).Range("C1") = .Range("H10") 'on indique le critère pour le filtre élaboré
Sheets(ville).Range("C2") = ville 'on indique le nom de la ville à filtrer
.Range("a10").CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(ville).Range("C1:C2"), Sheets(ville).Range("A6:I6"), False 'on renvoie toutes les personnes de la ville

Next 'ville suivante

End With
End Sub
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour le fil, bonjour le forum,

@titiboregan
Merci pour cet exemple car cela fait un paquet de temps que je me dit : il faut que j'utilise les filtres avancés ! J'ai toujours pas bien compris mais ton exemple va me servir de base pour faire des essais et enfin, j'espère assimiler et utiliser cette ressource.
 

titiborregan5

XLDnaute Accro
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

bonjour à tous,

@Robert (mais pas que ;)):
le filtre élaboré est une merveille je trouve!!! Je le balance un peu à toutes les sauces sur le forum car peu de gens connaissent et/ou utilisent car un peu "étrange" à appréhender au début mais tellement efficace!!!!

Le mieux je pense, c'est de t'entrainer sur le filtre élaboré avant de le mettre en VBA, pour lequel le code est assez simple tu le vois bien!
un lien parmi tant d'autres qui peut servir: Les filtres avancés ou élaborés dans Excel

Je suis là si besoin, mais il faut, à mon avis, absolument s'y mettre! Depuis que j'ai découvert ça je ne m'en lasse pas !!!

A+
Tibo

Edit: c'est aussi pour ça que je me suis permis de faire le code après le tien, car quand j'ai vu la "complexité" de ton code, je me suis dit ya tellement plus simple... et normalement pas de gestion d'erreur avec le filtre élaboré et ça c'est cool!!!
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour le fil, bonjour le forum,

Yeah ! Je crois que j'ai compris...

juste pour la foune (ou le fun, je maîtrise mal l'étranger...) le nouveau code avec filtre élaboré :
Code:
Public Sub Macro1()
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim I As Byte 'déclare la variable I (Incrément)
Dim OD As Object 'déclare la variable OD (Onglet Destination)

Set OS = Sheets("extract") 'définit l'onglet source OS
OS.Range("L10") = OS.Range("H10") 'copie en L10 l'étiquette de la donnée à filter
OS.Range("A10").CurrentRegion.AdvancedFilter xlFilterCopy, , OS.Range("L10"), True 'récupère la liste des villes sans doublon à partir de L11
For I = 11 To OS.Cells(Application.Rows.Count, 12).End(xlUp).Row 'boucle sur tous les élément uniques de la colonne L
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Sheets(OS.Cells(I, 12).Value) 'définit l'onglet de destination OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        Sheets("Template").Copy after:=Sheets(Sheets.Count) 'copy l'onglet "Template"
        ActiveSheet.Name = OS.Cells(I, 12).Value 'renomme la copie de l'onglet
        Set OD = ActiveSheet 'définit l'onglet de destination OD
    End If 'fin de la condition
    On Error GoTo 0 'supprime la gestion des erreurs
    OD.Range("C1").Value = OS.Range("H10") 'copie en C1 l'étiquette de la donnée à filter
    OD.Range("C2").Value = OS.Cells(I, 12).Value 'copie en C2 la valeur du critère du filtre
    OS.Range("A10").CurrentRegion.AdvancedFilter xlFilterCopy, OD.Range("C1:C2"), OD.Range("A6:I6"), False 'Copy les données filtrée dans l'onglet OD
    OD.Range("C1:C2").Clear 'efface la plage C1:C2 de l'onglet OD ayant servi au filtreavancé
Next I 'prochain élément de la boucle
OS.Range("L10:L" & OS.Cells(Application.Rows.Count, 12).End(xlUp).Row).Clear 'supprime la liste des éléments uniques de l'onglet OS ayant servi au filter avancée
End Sub
Encore merci à Titiborregan...
 

DoubleZero

XLDnaute Barbatruc
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour, anthonyhk, titiborregan5 :), Robert :), le Forum,

Une autre suggestion avec ce code (Module "Ici"), prenant en compte les facteurs "Code Postal" et "Ville".

Code:
Option Explicit
Sub Onglets_créer_renseigner()
    Dim o As Worksheet, c As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each o In Worksheets
        If o.Name <> "extract" And o.Name <> "Template" Then o.Delete
    Next
    Application.DisplayAlerts = True
    Range("G10:H65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AZ1:BA1"), Unique:=True
    Range("az:ba").Sort Key1:=Range("az1"), Order1:=xlAscending, Header:=xlYes
    For Each c In Range("ba2", Cells(Rows.Count, 53).End(3))
        Sheets("Template").Copy after:=Sheets(Sheets.Count)
        Range("az1") = "Code Postal": Range("ba1") = "Ville": Range("az2") = c.Offset(, -1): Range("ba2") = c
        ActiveSheet.Name = c: ActiveSheet.Tab.Color = 65535
        Sheets("extract").Range("a10:i65000").AdvancedFilter Action:=xlFilterCopy, _
             CriteriaRange:=Range("az1:ba2"), CopyToRange:=Range("a6:i6"), Unique:=False
        Range("az1:ba2").Clear
        Cells.EntireColumn.AutoFit
    Next
    Sheets("extract").Activate: Range("az:ba").Delete
    Application.ScreenUpdating = True
End Sub

A bientôt :)
 

Pièces jointes

  • 00 - anthonyhk - Onglets créer, renseigner.xls
    287 KB · Affichages: 54

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour le fil, bonjour le forum,

Oui c'est juste ! Je ne m'étais pas rendu compte de cette erreur... Du coup ça me rend les Filtres élaborés bien moins sympathiques...
 

titiborregan5

XLDnaute Accro
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour le fil, bonjour le forum,

Oui c'est juste ! Je ne m'étais pas rendu compte de cette erreur... Du coup ça me rend les Filtres élaborés bien moins sympathiques...
Hola todos!
Non suffit de filtrer sur 2 colonnes y basta... non?
Voilà le code où on rajoute le filtre sur cp
VB:
Sub filtre_elab()

With Sheets("extract")
.Range("L10") = .Range("H10") 'on recopie le titre de ce sur quoi on veut filtrer ici la ville
.Range("M10") = .Range("G10")
.Range("a10").CurrentRegion.AdvancedFilter xlFilterCopy, , .Range("L10:m10"), True 'on indique toutes les villes sans doublon via un filtre élaboré

For i = 11 To .Range("m65000").End(xlUp).Row 'à partir de la liste des villes créée juste avant on fait une boucle pour chaque ville
ville = .Cells(i, 12) 'on se rappelle du nom de la ville pour après
cp = .Cells(i, 13)
Sheets("template").Copy after:=Sheets(Sheets.Count) 'on copie la feuille template en dernier
Sheets(Sheets.Count).Name = ville 'on la renomme avec le nom de ville
Sheets(ville).Range("C1") = .Range("g10") 'on indique le critère pour le filtre élaboré
Sheets(ville).Range("C2") = cp 'on indique le nom de la ville à filtrer
.Range("a10").CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(ville).Range("C1:C2"), Sheets(ville).Range("A6:I6"), False 'on renvoie toutes les personnes de la ville

Next 'ville suivante

End With
End Sub

De plus, il a fallu corriger les CP pour Paris et ses arrondissements qui ont du être mis au hasard afin que paris 10 = 75010 etc...

Sinon ça marche!
 

Pièces jointes

  • agenda HE_E (1).xls
    419 KB · Affichages: 61
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour, le Fil, le Forum,

... Une autre suggestion avec ce code (Module "Ici"), prenant en compte les facteurs "Code Postal" et "Ville"...

Je ne comprends :confused: pas la raison pour laquelle le filtre avancé sur la colonne "Ville" ne distingue pas "Paris 1", de Paris 11", "Paris 15"... D'où le filtre sur le "Code Postal" et la "Ville".

Il y a certainement une explication et je vais, sans doute, ouvrir une discussion à ce sujet.

A bientôt :)
 

titiborregan5

XLDnaute Accro
Re : Copier/coller d'un onglet vers un autre onglet suivant un critère

Bonjour à tous,
Merci à tous !
C'est la première fois que j'entends parler du filtre élaboré ou avancé !
C'est super efficace en tout cas :)
Très!!!!! je me suis fait responsable marketing & communication du filtre élaboré ;)

Bonjour, le Fil, le Forum,

Citation Envoyé par DoubleZero Voir le message
... Une autre suggestion avec ce code (Module "Ici"), prenant en compte les facteurs "Code Postal" et "Ville"...
Je ne comprends pas la raison pour laquelle le filtre avancé sur la colonne "Ville" ne distingue pas "Paris 1", de Paris 11", "Paris 15"... D'où le filtre sur le "Code Postal" et la "Ville".

Il y a certainement une explication et je vais, sans doute, ouvrir une discussion à ce sujet.

A bientôt
@00: cette discussion a été créée ou pas? ça m'intéresse grandement de la suivre!!

A+ tout le monde!
 

Discussions similaires