XL 2013 Macro : Dispatcher un tableau dans d'autres feuilles

[Mak_tarmak]

Bonjour,

Pour le contexte, je débute dans le monde VBA. Je comprends le code mais je n’arrive pas encore à créer tout seul.

J’ai un traitement à faire sur la feuille « Worksheet » d’un fichier (extraction d’une appli web) qui m’est fourni par un collègue.
Dans ce fichier, seules les colonnes B à H m’intéressent.
Dans ce fichier, j’ai créé une feuille ATTESTATIONS et une feuille RELIQUAT qui va accueillir les données de « Worksheet » selon des critères.
Je crée deux feuilles différentes car les données de ATTESTATIONS serviront à alimenter une base de données (autre onglet) pour faire du publipostage et RELIQUAT me sert à avoir la liste des personnes qui ne répondaient pas aux critères et qui seront relancés par mail ou servira à faire un listing des personnes.
Tout ce qui va dans ATTESTATIONS c’est la recopie de B à H de la feuille « Worksheet » pour les personnes qui ont une date dans la colonne G et une note supérieure à 10 dans la colonne H.
Tout ce qui va dans RELIQUAT, c’est tout le reste des personnes même si une des deux colonnes est vide voire les deux.
Je dois retrouver dans ces deux feuilles toutes les personnes de Worksheet.et les entêtes de colonne.

Dans ma macro TraitementDATA() :
Je commence par supprimer la ligne qui contient « MOYENNE/THÉMATIQUE » dans « Worksheet » (cette ligne peut se trouver à n’importe quelle ligne)
je tri la colonne B par ordre alphabétique
je fais un petit nettoyage pour enlever l’image qui se nomme « General » mais elle n’est pas toujours présente
je dispatche les données dans ATTESTATIONS et RELIQUAT en fonction des critères énoncés plus haut. (j’ai mis un DoEvents après Activesheet.Paste car j’ai souvent une erreur 1004 mais ça plante toujours)
je supprime les lignes vides


Ma problématique première c’est la procédure FiltreWS mais aussi l’optimisation globale de mon code car j’ai utilisé l’enregistreur de macro par moment et le code est sûrement « sale ».
J’ai adapté un code trouvé sur le forum pour FiltreWS.
Vous verrez dans le fichier mais cette procédure lit ma feuille Worksheet de haut en bas et recopie les données dans les autres feuilles mais la feuille RELIQUAT n’a pas d’entête de colonne.
Peut-être que j’ai choisi la mauvaise procédure ou que je l’ai mal adapté. De plus, j’ai le problème sur la méthode Activesheet.Paste et je ne comprends pas pourquoi.

J’espère avoir été clair dans mes propos.

Merci pour votre aide,
Kader

 

[Hasco]

Bonjour,

Dans le fichier joint vous trouverez la macro 'Répartir' ci-dessous, qui utilise la méthode AdvancedFilter (filtrage avancé).

Pour une information sur la façon de construire vos critères voici un lien vers l'aide de la microsoft :

Filtrer à l’aide de critères avancés - Support Microsoft

Si les données Excel que vous souhaitez filtrer nécessitent des critères complexes, vous pouvez les filtrer à l’aide de critères avancés.

support.microsoft.com

Sub Repartir()
    '
    ' Filtre les données de Worksheet par Filtrage Avancé
    '
    Dim Source As Range, Destination As Range, Criteres As Range
    Dim Feuille As Variant

    '
    ' Définir la source des données
    Set Source = ThisWorkbook.Sheets("Worksheet").Range("B4").CurrentRegion
    With Source
        Set Source = .Offset(2).Resize(.Rows.Count - 2)
    End With
    '
    ' Parcours des feuilles de destination
    For Each Feuille In ThisWorkbook.Sheets(Array("ATTESTATIONS", "RELIQUAT"))
        '
        ' Définition, nettoyage de la destination
        With Feuille.Range("B1:B2").CurrentRegion
            .ClearContents
            Set Destination = .Resize(1, Source.Columns.Count)
        End With
        '
        ' Mise en place des entêtes de colonnes puis définition de la plage Critères
        With Destination
            .Rows(1).Value = Source.Rows(1).Value
            '
            ' Définition de la plage de critère en fonction du nom de la feuille
            ' Abs(Feuille.Name = "RELIQUAT") rajoutera 1 ligne si RELIQUAT
            Set Criteres = .Offset(, .Columns.Count + 1).Resize(2 + Abs(Feuille.Name = "RELIQUAT"), 2)
        End With
        '
        ' traiter les critères de filtre suivant la feuille en cours
       
        With Criteres
            .Rows(1).Value = Source.Columns(6).Resize(1, 2).Value
            '
            If Feuille.Name = "ATTESTATIONS" Then
               
                .Cells(2, 1).Value = "<>" 'Date non vide
                .Cells(2, 2).Value = ">=10" ' ET note Supérieure ou égale 10
            Else
                .Cells(2, 1).Value = "="     ' Date vide
                .Cells(2, 2).Value = "="     ' Note vide
                .Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10
               
            End If
        End With
        '
        ' Application de la méthode AdvancedFilter
        Source.AdvancedFilter xlFilterCopy, Criteres, Destination.Resize(1)
        '
        ' Effachement de la zone de critère
        Criteres.ClearContents
    Next
End Sub

 

[Mak_tarmak]

Bonjour,

Dans le fichier joint vous trouverez la macro 'Répartir' ci-dessous, qui utilise la méthode AdvancedFilter (filtrage avancé).

Pour une information sur la façon de construire vos critères voici un lien vers l'aide de la microsoft :

Sub Repartir()
    '
    ' Filtre les données de Worksheet par Filtrage Avancé
    '
    Dim Source As Range, Destination As Range, Criteres As Range
    Dim Feuille As Variant

    '
    ' Définir la source des données
    Set Source = ThisWorkbook.Sheets("Worksheet").Range("B4").CurrentRegion
    With Source
        Set Source = .Offset(2).Resize(.Rows.Count - 2)
    End With
    '
    ' Parcours des feuilles de destination
    For Each Feuille In ThisWorkbook.Sheets(Array("ATTESTATIONS", "RELIQUAT"))
        '
        ' Définition, nettoyage de la destination
        With Feuille.Range("B1:B2").CurrentRegion
            .ClearContents
            Set Destination = .Resize(1, Source.Columns.Count)
        End With
        '
        ' Mise en place des entêtes de colonnes puis définition de la plage Critères
        With Destination
            .Rows(1).Value = Source.Rows(1).Value
            '
            ' Définition de la plage de critère en fonction du nom de la feuille
            ' Abs(Feuille.Name = "RELIQUAT") rajoutera 1 ligne si RELIQUAT
            Set Criteres = .Offset(, .Columns.Count + 1).Resize(2 + Abs(Feuille.Name = "RELIQUAT"), 2)
        End With
        '
        ' traiter les critères de filtre suivant la feuille en cours
      
        With Criteres
            .Rows(1).Value = Source.Columns(6).Resize(1, 2).Value
            '
            If Feuille.Name = "ATTESTATIONS" Then
              
                .Cells(2, 1).Value = "<>" 'Date non vide
                .Cells(2, 2).Value = ">=10" ' ET note Supérieure ou égale 10
            Else
                .Cells(2, 1).Value = "="     ' Date vide
                .Cells(2, 2).Value = "="     ' Note vide
                .Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10
              
            End If
        End With
        '
        ' Application de la méthode AdvancedFilter
        Source.AdvancedFilter xlFilterCopy, Criteres, Destination.Resize(1)
        '
        ' Effachement de la zone de critère
        Criteres.ClearContents
    Next
End Sub

Bonjour Hasco,

Merci beaucoup pour la macro, le traitement est hyper rapide.
Merci de l'avoir commenté, cela m'aidera à comprendre comment elle marche.
Merci aussi pour le lien de Microsoft.
Dans l'onglet RELIQUAT je ne retrouve que les noms des personnes qui n'avait ni date, ni note alors que je dois retrouver également celles qui ont soit seulement la date, soit seulement la note, soit une date avec une note <10. A quelle niveau de la macro puis-je faire la modif ?

Merci pour votre aide,

 

[Mak_tarmak]

Bonjour Hasco,

Merci beaucoup pour la macro, le traitement est hyper rapide.
Merci de l'avoir commenté, cela m'aidera à comprendre comment elle marche.
Merci aussi pour le lien de Microsoft.
Dans l'onglet RELIQUAT je ne retrouve que les noms des personnes qui n'avait ni date, ni note alors que je dois retrouver également celles qui ont soit seulement la date, soit seulement la note, soit une date avec une note <10. A quelle niveau de la macro puis-je faire la modif ?

Merci pour votre aide,

Hasco,

Pour celles qui ont une date et une note <10, ça marche
En fait, je n'avais pas de cas dans mon onglet Worksheet avec une date et une note <10 alors j'en ai créé.
Par contre, je n'ai pas encore trouvé pour celles qui ont soit seulement une date, soit seulement une note, tout en gardant aussi celles qui n'ont ni l'un ni l'autre, ça me fait 4 conditions.

 

[Mak_tarmak]

Hasco,

Pour celles qui ont une date et une note <10, ça marche
En fait, je n'avais pas de cas dans mon onglet Worksheet avec une date et une note <10 alors j'en ai créé.
Par contre, je n'ai pas encore trouvé pour celles qui ont soit seulement une date, soit seulement une note, tout en gardant aussi celles qui n'ont ni l'un ni l'autre, ça me fait 4 conditions.

Bonjour Hasco,

En me relisant, je m'aperçois que je n'étais pas clair.
J'ai refait un test sur le fichier source et j'ai qu'une condition de critère qui ne marche pas.

Voici ce que je devrais avoir dans la répartition à partir des données de l'onglet Worksheet :

- Dans ATTESTATIONS,
DATE en G et NOTE >10 en H => ok ça marche

- Dans RELIQUAT,
ni DATE en G, ni NOTE en H => ok ça marche
pas de DATE en G, NOTE en H (peu importe si >10 ou <10) => ok ça marche seulement pour <10
DATE en G, pas de NOTE en H=> KO
DATE en G, NOTE <10 en H => ok ça marche

J'ai essayé de modifier les conditions du else mais j'ai fait pire.
J'ai lancé en mode pas détaillé et j'ai vu qu'on passait d'abord dans la feuille ATTESTATIONS en posant les critères dans la feuille et en les effaçant puis qu'on faisait la même chose dans RELIQUAT mais j'avoue qu'après je n'ai pas trop compris le fonctionnement.

Je joins un fichier avec tous les types de cas et je m'excuse de ne pas les avoir mis dès le départ.

Merci,

 

[cp4]

Bonjour,

Si j'ai compris, il suffit de neutraliser la ligne de code ci-dessous se trouvant juste après le 'Esle'

.Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10

Bonne journée.

 

[Mak_tarmak]

Bonjour,

Si j'ai compris, il suffit de neutraliser la ligne de code ci-dessous se trouvant juste après le 'Esle'

.Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10

Bonne journée.

Bonjour cp4,
Ravi de te revoir.

Malheureusement en désactivant la ligne ça induit d'autres problèmes.

ça corrige cette ligne :
pas de DATE en G, NOTE en H (peu importe si >10 ou <10) => ok ça marche

ça ne marche toujours pas :
DATE en G, pas de NOTE en H=> KO

de plus, ça me duplique les personnes en ATTESTATIONS :
DATE en G et note > 10 se retrouvent aussi dans RELIQUAT

Merci pour ton aide,

 

[cp4]

Bonjour cp4,
Ravi de te revoir.

Malheureusement en désactivant la ligne ça induit d'autres problèmes.

ça corrige cette ligne :
pas de DATE en G, NOTE en H (peu importe si >10 ou <10) => ok ça marche

ça ne marche toujours pas :
DATE en G, pas de NOTE en H=> KO

de plus, ça me duplique les personnes en ATTESTATIONS :
DATE en G et note > 10 se retrouvent aussi dans RELIQUAT

Merci pour ton aide,

Re,

Je t'avoue que je n'ai pas vérifié le résultat. Qui me semble un peu difficile à faire car tu as mis beaucoup de lignes. Tu aurai dû réduire tes lignes au strict nécessaire pour vérifier assez rapidement le rendu du code.
Je ne comprends pas pourquoi ça induit d'autres erreurs car les lignes de code après le 'else' concerne la feuille 'reliquat'.

 

[Hasco]

Bonjour,

Bonjour,

Si j'ai compris, il suffit de neutraliser la ligne de code ci-dessous se trouvant juste après le 'Esle'

.Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10

Bonne journée.

Non cela ne marche pas.

@Mak_tarmak avez -vous été voir le lien que je vous ai donné sur l'aide microsoft et la construction des critères.
Appuyez-vous sur ces exemples. C'est à vous de chercher la bonne conbinaison. Sans oublier les cas.
Par exemple vous parlez des <10 et des >10 mais jamais des = 10 !!!!!

Quand vous pensez OU demandez-vous s'il s'agit d'un ou exclusif ou inclusif (et/ou).

Commentez la ligne

Criteres.ClearContents

Et faites des tests manuels (filtre avancé) et lorsque vous aurez trouver la bonne combinaison, nous les intégrerons à la macro.

Cordialement

 

[Hasco]

Re,

Testez la macro ci-dessous qui rajoute une ligne de critère pour Date en G et pas de note en H :

Sub Repartir()
    '
    ' Filtre les données de Worksheet par Filtrage Avancé
    '
    Dim Source As Range, Destination As Range, Criteres As Range
    Dim Feuille As Variant

    '
    ' Définir la source des données
    Set Source = ThisWorkbook.Sheets("Worksheet").Range("B4").CurrentRegion
    With Source
        Set Source = .Offset(2).Resize(.Rows.Count - 2)
    End With
    '
    ' Parcours des feuilles de destination
    For Each Feuille In ThisWorkbook.Sheets(Array("ATTESTATIONS", "RELIQUAT"))
        '
        ' Définition, nettoyage de la destination
        With Feuille.Range("B1:B2").CurrentRegion
            .ClearContents
            Set Destination = .Resize(1, Source.Columns.Count)
        End With
        '
        ' Mise en place des entêtes de colonnes puis définition de la plage Critères
        With Destination
            .Rows(1).Value = Source.Rows(1).Value
            '
            ' Définition de la plage de critère en fonction du nom de la feuille
            ' Abs(Feuille.Name = "RELIQUAT") rajoutera 1 ligne si RELIQUAT
            Set Criteres = .Offset(, .Columns.Count + 1).Resize(2 + (2 * Abs(Feuille.Name = "RELIQUAT")), 2)
        End With
        '
        ' traiter les critères de filtre suivant la feuille en cours
        
        With Criteres
            .Rows(1).Value = Source.Columns(6).Resize(1, 2).Value
            '
            If Feuille.Name = "ATTESTATIONS" Then
                
                .Cells(2, 1).Value = "<>" 'Date non vide
                .Cells(2, 2).Value = ">=10" ' ET note Supérieure ou égale 10
            Else
                .Cells(2, 1).Value = "="     ' Date vide
                .Cells(2, 2).Value = "="     ' Note vide
                .Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10
                .Cells(4, 1).Value = "<>"    ' Date en G
                .Cells(4, 2).Value = "="     ' et pas de note
            End If
        End With
        '
        ' Application de la méthode AdvancedFilter
        Source.AdvancedFilter xlFilterCopy, Criteres, Destination.Resize(1)
        '
        ' Effachement de la zone de critère
        'Criteres.ClearContents
    Next
End Sub

J'ai commenté la ligne qui efface les critères.

Cordialement

 

[Mak_tarmak]

Bonjour,


Non cela ne marche pas.

@Mak_tarmak avez -vous été voir le lien que je vous ai donné sur l'aide microsoft et la construction des critères.
Appuyez-vous sur ces exemples. C'est à vous de chercher la bonne conbinaison. Sans oublier les cas.
Par exemple vous parlez des <10 et des >10 mais jamais des = 10 !!!!!

Quand vous pensez OU demandez-vous s'il s'agit d'un ou exclusif ou inclusif (et/ou).

Commentez la ligne

Et faites des tests manuels (filtre avancé) et lorsque vous aurez trouver la bonne combinaison, nous les intégrerons à la macro.

Cordialement

Bonjour Hasco,
Oui j'ai été voir le lien mais j'avoue que je pensais que c'était pour m'informer si j'avais d'autres critères à ajouter à votre macro et je n'ai pas plus creuser que ça, je me concentrais sur la compréhension du fonctionnement de la macro.

Il est vrai que je ne me suis pas posé la question du OU exclusif ou inclusif.

Je n'avais pas pensé aux tests manuels.

Merci,
Cordialement,

 

[Mak_tarmak]

Re,

Testez la macro ci-dessous qui rajoute une ligne de critère pour Date en G et pas de note en H :

Sub Repartir()
    '
    ' Filtre les données de Worksheet par Filtrage Avancé
    '
    Dim Source As Range, Destination As Range, Criteres As Range
    Dim Feuille As Variant

    '
    ' Définir la source des données
    Set Source = ThisWorkbook.Sheets("Worksheet").Range("B4").CurrentRegion
    With Source
        Set Source = .Offset(2).Resize(.Rows.Count - 2)
    End With
    '
    ' Parcours des feuilles de destination
    For Each Feuille In ThisWorkbook.Sheets(Array("ATTESTATIONS", "RELIQUAT"))
        '
        ' Définition, nettoyage de la destination
        With Feuille.Range("B1:B2").CurrentRegion
            .ClearContents
            Set Destination = .Resize(1, Source.Columns.Count)
        End With
        '
        ' Mise en place des entêtes de colonnes puis définition de la plage Critères
        With Destination
            .Rows(1).Value = Source.Rows(1).Value
            '
            ' Définition de la plage de critère en fonction du nom de la feuille
            ' Abs(Feuille.Name = "RELIQUAT") rajoutera 1 ligne si RELIQUAT
            Set Criteres = .Offset(, .Columns.Count + 1).Resize(2 + (2 * Abs(Feuille.Name = "RELIQUAT")), 2)
        End With
        '
        ' traiter les critères de filtre suivant la feuille en cours
       
        With Criteres
            .Rows(1).Value = Source.Columns(6).Resize(1, 2).Value
            '
            If Feuille.Name = "ATTESTATIONS" Then
               
                .Cells(2, 1).Value = "<>" 'Date non vide
                .Cells(2, 2).Value = ">=10" ' ET note Supérieure ou égale 10
            Else
                .Cells(2, 1).Value = "="     ' Date vide
                .Cells(2, 2).Value = "="     ' Note vide
                .Cells(3, 2).Value = "<10"   ' OU Note inférieure à 10
                .Cells(4, 1).Value = "<>"    ' Date en G
                .Cells(4, 2).Value = "="     ' et pas de note
            End If
        End With
        '
        ' Application de la méthode AdvancedFilter
        Source.AdvancedFilter xlFilterCopy, Criteres, Destination.Resize(1)
        '
        ' Effachement de la zone de critère
        'Criteres.ClearContents
    Next
End Sub

J'ai commenté la ligne qui efface les critères.

Cordialement

Re,

merci Hasco.

Je ne comprends pas bien comment fonctionne les critères du Else.
Ils sont dans un ordre particulier ? Ils sont combinés entre eux ?

Cordialement,

 

[Hasco]

Re,

ils s'ajoutent l'un à l'autre, ligne à ligne sur deux cellules.
Je vous disais de décommenter la ligne de suppression des critères dans la feuille.
Vous l'auriez fait, vous auriez vu comment ça marche après avoir lancé la macro éventuellement en pas à pas après avoir mis un point d'arrêt (F9) sur la première ligne sous le Else.

Telle qu'écrite dans mon dernier post la macro donne la zone de critère ci-dessous dans la feuille RELIQUAT en cellule L1:M4
Session POST / Bulle de Compétences : La Téléassistance Groupe 1 du 26/01/2022

Date de Formation	Note / 20
=	=
	<10
<>	=

La première ligne est la ligne des entêtes de colonnes
La deuxième ligne est pour les Dates vides ET notes vides
La troisième ligne est pour les Notes <10
La quatrième ligne est pour les Date NON vides et les Note vides

Et encore une fois faites vos propres essais, c'est la meilleur façon de comprendre.

vous pouvez également le faire avec le complément Power Query à téléchargé sur le site de microsoft

Download Microsoft Power Query pour Excel from Official Microsoft Download Center

Microsoft Power Query pour Excel est un complément Excel qui améliore l'expérience du décisionnel libre-service dans Excel en simplifiant la récupération des données, l'accès et la collaboration.

www.microsoft.com

 

[Mak_tarmak]

Re,

Je t'avoue que je n'ai pas vérifié le résultat. Qui me semble un peu difficile à faire car tu as mis beaucoup de lignes. Tu aurai dû réduire tes lignes au strict nécessaire pour vérifier assez rapidement le rendu du code.
Je ne comprends pas pourquoi ça induit d'autres erreurs car les lignes de code après le 'else' concerne la feuille 'reliquat'.

Re,
J'ai tenu compte de tes remarques, j'ai allégé le fichier au strict nécessaire et j'ai rajouté des couleurs pour que ce soit plus visuel.
J'ai gardé 3 cas pour chaque condition.

- Dans ATTESTATIONS,
DATE en G et NOTE >10 en H => JAUNE

- Dans RELIQUAT,
ni DATE en G, ni NOTE en H => BLEU
pas de DATE en G, NOTE en H => ROSE
DATE en G, pas de NOTE en H => MARRON
DATE en G, NOTE <10 en H => VERT

Avec la nouvelle macro de Hasco, on voit tout de suite :
Dans ATTESTATIONS, on a bien les 3 cas JAUNE

Dans RELIQUAT, on a bien les 3 cas BLEU, les 3 cas MARRON, les 3 cas VERT mais qu'un seul cas ROSE.
Les notes <10 sont prises en compte mais pas celles qui sont >10 et qui n'ont pas de DATE.

Je vais creuser un peu plus,

 

[Mak_tarmak]

Re,

ils s'ajoutent l'un à l'autre, ligne à ligne sur deux cellules.
Je vous disais de décommenter la ligne de suppression des critères dans la feuille.
Vous l'auriez fait, vous auriez vu comment ça marche après avoir lancé la macro éventuellement en pas à pas après avoir mis un point d'arrêt (F9) sur la première ligne sous le Else.

Telle qu'écrite dans mon dernier post la macro donne la zone de critère ci-dessous dans la feuille RELIQUAT en cellule L1:M4
Session POST / Bulle de Compétences : La Téléassistance Groupe 1 du 26/01/2022

Date de Formation	Note / 20
=	=
	<10
<>	=

La première ligne est la ligne des entêtes de colonnes
La deuxième ligne est pour les Dates vides ET notes vides
La troisième ligne est pour les Notes <10
La quatrième ligne est pour les Date NON vides et les Note vides

Et encore une fois faites vos propres essais, c'est la meilleur façon de comprendre.

vous pouvez également le faire avec le complément Power Query à téléchargé sur le site de microsoft

Re,

Merci pour ces explications.
Je ne demande que ça de faire mes essais mais j'avais besoin d'éclaircissements et vos explications m'ont aidé en cela.
Avec aussi l'aide de cp4, j'ai retravaillé mon fichier pour qu'il soit épuré avec juste 3 cas par conditions et des couleurs pour que cela soit plus visuel.

Merci encore pour votre aide.