• Publicité

Copier/coller certaines lignes en fonction d'un critère V2

Dans ce forum, vous pouvez poser toutes vos questions concernant l'utilisation de logiciels de bureautique (Microsoft Office, Open Office, etc.)

Modérateurs: Sebastien, Stéphane, Christophe

Copier/coller certaines lignes en fonction d'un critère V2

Messagepar Projet boulot » 14 Sep 2017 16:01

Bonjour, :youpi:

Je cherche à faire fonctionner une extraction, mais malgré ma très bonne connaissance des formules Excel,... Ce que je souhaite faire aujourd'hui nécessite une macro et je n'y connais encore rien.
:Teeheehee2:

J'ai retrouvé un ancien post (http://www.astucesinternet.com/forum/topic2869.html) qui avait le même problème, mais je n'arrive pas à l'adapter :
3 raisons :
1. je ne suis pas sur de bien créer la macro au bon endroit (sur une feuille ou un module ?)
2. Excel indique "Erreur d’exécution '9' (L'indice n'appartient pas à la sélection)"
3. je n'arrive pas à l'écrire complètement

J'ai une feuille avec les données appelée "Base complémentaire" que je souhaite extraire sur une nouvelle feuille [existante] "DP - AUDE PO"
Sur la feuille "Base complémentaire" si dans la colonne B, le critère "AUDE" ou "PO" ressort, je souhaite copier sur la feuille "DP - AUDE PO" les lignes (validées par le critère) des colonnes B (pas C ni D) E à H (pas I) puis J et K (pas L) <---- présentent sur la feuille "Base complémentaire".
Voici ce que j'ai repris du code de l'ancien topic en essayant de modifier les noms + une partie pour éviter les doublons.

Merci infiniment à qui m'aidera ! :mercibcp:

J'identifie un premier problème : je nomme mal les feuilles : "Base complémentaire" quand ça devrait être "DP - AUDE PO" ou encore "Macro1" ....et inversement

Code: Tout sélectionner
Sub Macro1()
'
' Macro1 Macro
'
Dim ligne As Integer
Dim controle As String

'Sélection de la feuille Extract
Sheets("Base complémentaire").Select
Range("B4").Select
 
'Vérification du critère de sélection Equip V642
Do While ActiveCell.Value <> "" 'Boucle tant qu'on ne tombe pas sur une cellule vide
        If ActiveCell.Value Like "AUDE*" Then
           
            ligne = ActiveCell.Row              'on stoke le numéro de ligne
            controle = Cells(ligne, 5).Value    'on stocke le numéro fi pour vérification des doublons
           
            'copie de la ligne (colonne E à K)
            Range(Cells(ligne, 5), Cells(ligne, 11)).Copy
            Sheets("AUDE").Activate
            Range("B9").Select
       
            'cas numero 1 : aucune ligne n'a déjà été exportée
            If ActiveCell.Offset(1, 0).Value = "" Then
                ActiveCell.Offset(1, 0).Select
               
                'controle doublon
                If Application.WorksheetFunction. _
                    CountIf(Range("B:B"), controle) = 0 Then
               
                    'Pas de doublon : collage de la ligne
                    ActiveSheet.Paste
                    Sheets("Base complémentaire").Select
                    ActiveCell.Offset(1, 0).Select
                   
                    'Doublon détecté
                Else: GoTo doublon:
                End If
               
            'cas numero 2 : des lignes ont déjà été exportées
            Else
                Selection.End(xlDown).Select
                ActiveCell.Offset(1, 0).Select
               
                'controle doublon
                If Application.WorksheetFunction. _
                    CountIf(Range("B:B"), controle) = 0 Then
                   
                    'Pas de doublon : collage de la ligne
                    ActiveSheet.Paste
                    Sheets("Base complémentaire").Select
                    ActiveCell.Offset(1, 0).Select
                   
                'Doublon détecté
                Else: GoTo doublon:
                End If
               
            End If
       
        'pas de Equip V642 dans la cellule
        Else
            ActiveCell.Offset(1, 0).Select
    End If
   
GoTo boucle:

doublon:
Sheets("Base complémentaire").Select
ActiveCell.Offset(1, 0).Select
   
boucle:
Loop
   
End Sub
Projet boulot
No0b
No0b
 
Messages: 3
Enregistré le: 14 Sep 2017 15:41

Re: Copier/coller certaines lignes en fonction d'un critère

Messagepar Projet boulot » 18 Sep 2017 13:01

Pour updater mon post, ci joint le fichier en référence :

http://www.cjoint.com/c/GIsmag47w1i

Merci pour l'aide :mercibcp:
Projet boulot
No0b
No0b
 
Messages: 3
Enregistré le: 14 Sep 2017 15:41

Re: Copier/coller certaines lignes en fonction d'un critère

Messagepar Sebastien » 19 Sep 2017 18:35

Bonjour,

Je vais tenter de vous faire un truc en me basant sur l'ancienne macro.

Une question cependant : Le but est d'extraire des lignes en fonction de critères. Si à chaque lancement de la macro, on réinitialise le contenu de "DP + Aude PO", et qu'on y place le contenu de l'extraction, on ne devrait pas avoir à gérer des doublons. Ça peut vous convenir ? Car dans le cas de la macro que vous citez, il y avait un champ contenant un critères unique, ce qui ne semble pas être votre cas.

@+
Image
Avatar de l’utilisateur
Sebastien
Administrateur
Administrateur
 
Messages: 5504
Enregistré le: 14 Fév 2005 19:17
Localisation: LILLE

Re: Copier/coller certaines lignes en fonction d'un critère

Messagepar Projet boulot » 20 Sep 2017 13:05

Sebastien a écrit:Bonjour,

Je vais tenter de vous faire un truc en me basant sur l'ancienne macro.

Une question cependant : Le but est d'extraire des lignes en fonction de critères. Si à chaque lancement de la macro, on réinitialise le contenu de "DP + Aude PO", et qu'on y place le contenu de l'extraction, on ne devrait pas avoir à gérer des doublons. Ça peut vous convenir ? Car dans le cas de la macro que vous citez, il y avait un champ contenant un critères unique, ce qui ne semble pas être votre cas.

@+



Effectivement la base est supprimée à chaque fois et remise à jour à chaque nouvelle utilisation. Je ne pense pas après réflexion que traiter les cas de doublons soit utile puisque la base "de base" ne doit déjà pas en contenir.

Par contre à la différence de la macro sur laquelle j'avais commencé ma réflexion, il y a deux critères possibles pour copie. Et les colonnes à copier sont "segmentées" (dans plusieurs colonnes par toujours juxtaposées)
-----> Rappel : B (pas C ni D) E à H (pas I) puis J et K (pas L)

Merci beaucoup pour ce retour en tout cas ! :youpi:
Projet boulot
No0b
No0b
 
Messages: 3
Enregistré le: 14 Sep 2017 15:41

Re: Copier/coller certaines lignes en fonction d'un critère

Messagepar Sebastien » 20 Sep 2017 22:17

Bonjour,

Projet boulot a écrit:Par contre à la différence de la macro sur laquelle j'avais commencé ma réflexion, il y a deux critères possibles pour copie.

Pas de problème par rapport à ça, c'est juste une condition de plus.

J'ai déjà une solution à proposer. Le temps de tester un peu le code et de le commenter pour qu'il soit réutilisable (par vous dans d'autres onglets ou par d'autres visiteurs de notre forum) et je poste le fichier et la macro (demain soir normalement).

@+
Image
Avatar de l’utilisateur
Sebastien
Administrateur
Administrateur
 
Messages: 5504
Enregistré le: 14 Fév 2005 19:17
Localisation: LILLE

Re: Copier/coller certaines lignes en fonction d'un critère

Messagepar Sebastien » 21 Sep 2017 19:23

Bonjour,

Ci-dessous le code de la macro et un fichier permettant de la tester.

Code: Tout sélectionner
Sub Copie_Aude()

Dim svce As String, nom As String, prenom As String, debut As String, fin As String, motif As String, detail As String
Dim ligne As Integer

'Sélection de la feuille "Base complémentaire"
Sheets("Base complémentaire").Select

'Sélection de la cellule B4 - Première cellule contenant le critère de recherche
Range("B4").Select

'Création d'une boucle pour traiter toutes les lignes de la base
'La macro va traiter toute les lignes jusqu'à ce
'qu'elle trouve une cellule vide dans la colonne B
Do While ActiveCell.Value <> ""
   
   
'Critères de recherche
'----------------------
'Si la cellule contient "AUDE" ou "PO"
    If ActiveCell.Value = "AUDE" Or ActiveCell.Value = "PO" Then

'On enregistre le numéro de la ligne dans une variable
        ligne = ActiveCell.Row

'On enregistre les données qu'on souhaite exporter dans des variables
        svce = Cells(ligne, 2).Value
        nom = Cells(ligne, 5).Value
        prenom = Cells(ligne, 6).Value
        debut = Cells(ligne, 7).Value
        fin = Cells(ligne, 8).Value
        motif = Cells(ligne, 10).Value
        detail = Cells(ligne, 11).Value

'On se place dans la feuille "DP + Aude PO)
        Sheets("DP + Aude PO").Activate
'On se place en A3 = La première cellule de la zone de titre
        Range("A3").Select


'Vérification du contenu du tableau cible
'Si la ligne juste en dessous est vide (donc le tableau est vide)
        If ActiveCell.Offset(1, 0).Value = "" Then

'On se place sur la cellule du dessous
            ActiveCell.Offset(1, 0).Select

'On colle les données qu'on a placé en variables
            ActiveCell.Value = svce
            ActiveCell.Offset(0, 1).Value = nom
            ActiveCell.Offset(0, 2).Value = prenom
            ActiveCell.Offset(0, 3).Value = debut
            ActiveCell.Offset(0, 4).Value = fin
            ActiveCell.Offset(0, 5).Value = motif
            ActiveCell.Offset(0, 6).Value = detail

'On retourne sur la feuille "Base complémentaire"
            Sheets("Base complémentaire").Select

'On se place sur la cellule du dessous pour traiter la prochaine ligne
            ActiveCell.Offset(1, 0).Select


'Vérification du contenu du tableau cible
'Si la ligne juste en dessous n'est pas vide (donc le tableau contient déjà des données)
        Else

'On se place sur la dernière ligne remplie du tableau
            Selection.End(xlDown).Select

'On se place sur la ligne du dessous
            ActiveCell.Offset(1, 0).Select

'On colle les données qu'on a placé en variables
            ActiveCell.Value = svce
            ActiveCell.Offset(0, 1).Value = nom
            ActiveCell.Offset(0, 2).Value = prenom
            ActiveCell.Offset(0, 3).Value = debut
            ActiveCell.Offset(0, 4).Value = fin
            ActiveCell.Offset(0, 5).Value = motif
            ActiveCell.Offset(0, 6).Value = detail
            Sheets("Base complémentaire").Select
            ActiveCell.Offset(1, 0).Select
        End If

'Si la cellule ne contient pas "AUDE" ou "PO"
    Else

'On se place sur le ligne suivante
        ActiveCell.Offset(1, 0).Select
   
    End If

'On boucle
Loop
   
End Sub


Il suffit de lancer la macro nommée "Copie_Aude".
J'ai commenté le code pour que vous puissiez facilement l'adapter à d'autres critères de recherche.

Le fichier :
https://www.astucesinternet.com/data/images_forum/Doc_Travail_Macro.zip

@+
Image
Avatar de l’utilisateur
Sebastien
Administrateur
Administrateur
 
Messages: 5504
Enregistré le: 14 Fév 2005 19:17
Localisation: LILLE


Retourner vers Forum d'entraide : Bureautique

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 5 invités

  • Publicité