Macro excel pour copier contenu de certains onglets

edi -  
 edi -
Bonjour,
J'ai un fichier excel qui contient 5 feuilles et la première est nommée « IG ».
L'objectif de la macro est que si les lignes des différentes feuilles remplissent certaines conditions, alors on doit copier certaines cellules de ces lignes dans la feuille « Alertes_recos ».
J'ai deux soucis avec la macro que j'ai.
1. La fonction if devrait remplir les trois conditions (Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO") et la cela ne fonctionne pas tel qu'écrit.
2. Le deuxième souci est que je souhaite qu'à l'ajout d'une nouvelle ligne qui remplit les conditions dans l'une des feuilles, l'exécution de la macro puisse ajouter cette ligne et non pas dupliquer les autres résultats déjà affichés. (Actuellement lorsque j'exécute la macro deux fois, les lignes qui remplissent les conditions sont dupliquées dans l'onglet « Alertes_recos ».

Ci-dessous ma macro :
Merci de votre aide.

Sub MAJ()
Dim ws As Worksheet
Sheets("IG").Select
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Activate

Dim i As Long
Application.ScreenUpdating = False
'Sheets("Alertes_Recos").Columns(1).Clear
'Sheets("Alertes_Recos").Columns(2).Clear
'Sheets("Alertes_Recos").Columns(3).Clear
'Sheets("Alertes_Recos").Columns(4).Clear
'Sheets("Alertes_Recos").Columns(5).Clear
'Sheets("Alertes_Recos").Columns(6).Clear
'Sheets("Alertes_Recos").Columns(7).Clear
'Sheets("Alertes_Recos").Columns(8).Clear
For i = Cells(Rows.Count, "l").End(xlUp).Row To 2 Step -1
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("a" & i).Copy Destination:=Sheets("Alertes_Recos").Range("a" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("b" & i).Copy Destination:=Sheets("Alertes_Recos").Range("b" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("e" & i).Copy Destination:=Sheets("Alertes_Recos").Range("c" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("g" & i).Copy Destination:=Sheets("Alertes_Recos").Range("d" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("h" & i).Copy Destination:=Sheets("Alertes_Recos").Range("e" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("j" & i).Copy Destination:=Sheets("Alertes_Recos").Range("f" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("k" & i).Copy Destination:=Sheets("Alertes_Recos").Range("g" & Rows.Count).End(xlUp)(2)
If Range("l" & i) = "Échéance proche" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("l" & i).Copy Destination:=Sheets("Alertes_Recos").Range("h" & Rows.Count).End(xlUp)(2)
Next i
Application.ScreenUpdating = True
Next ws
End Sub]

3 réponses

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    pour la première question: 
              If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("a" & i).Copy Destination:=Sheets("Alertes_Recos").Range("a" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("b" & i).Copy Destination:=Sheets("Alertes_Recos").Range("b" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("e" & i).Copy Destination:=Sheets("Alertes_Recos").Range("c" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("g" & i).Copy Destination:=Sheets("Alertes_Recos").Range("d" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("h" & i).Copy Destination:=Sheets("Alertes_Recos").Range("e" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("j" & i).Copy Destination:=Sheets("Alertes_Recos").Range("f" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("k" & i).Copy Destination:=Sheets("Alertes_Recos").Range("g" & Rows.Count).End(xlUp)(2)
            If Range("l" & i) = "Échéance proche" And Range("g" & i) = "DPO" Or Range("l" & i) = "En retard" And Range("g" & i) = "DPO" Then Range("l" & i).Copy Destination:=Sheets("Alertes_Recos").Range("h" & Rows.Count).End(xlUp)(2)

    Pour la deuxième, je ne comprends pas, si vous relancez la macro, il est normal que le cycle se reproduise, et ce, autant de fois que vous la lancerez. Donnez plus de détail ou mieux, un exemple.
    Cdlt
    0
    1. edi
       
      Bonjour Frenchie83,
      Merci pour ton retour.
      Pour le premier point c'est OK. Par contre pour le second, justement je veux que le cycle se reproduise mais qu'il ne duplique pas les premiers résultats déjà affichés... en fait je ne veux pas de doublons quelque soit le nombre d'exécution de la macro... Est ce qu'il y a une possibilité d'améliorer la macro pour prendre en compte cet aspect ?
      0
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Pas de doublons OK, mais dans la feuille "IG", Quelle colonne doit -on prendre comme référence qui ne doit pas se retrouver plus d'une fois dans la feuille "Alertes_recos"? et de quelle nature est cette référence, numérique? alphanumérique?, Texte? Date? Soyez plus précis dans vos demandes.
    Mettez une extrait de votre fichier sans données personnelles sur cjoint.com (suivre la procédure) et collez le lien ici.
    Cdlt
    0
    1. edi
       
      Bonsoir Frenchie,
      J'ai ajouté un exemple du fichier sur cjoint.com:
      http://www.cjoint.com/c/EGCvjispGy3
      0
    2. Frenchie83 Messages postés 2254 Statut Membre 339
       
      Bonjour
      Merci d'avoir joint un extrait de votre fichier, mais vous n'avez pas répondu à ma question concernant les doublons, je suppose donc qu'il ne doit pas y avoir 2 fois le même n° de recopie dans la feuille "Alertes_Recos". Je regarde ça et vous répond dans la journée.
      Cdlt
      0
    3. edi
       
      Bonjour Frenchie,
      Désolé encore. Pour répondre à votre question, par exemple dans la fiche "IG", je ne dois pas avoir la même ligne qui se repète plus de deux fois dans la feuille "Alertes_Recos".
      On pourrait prendre comme référence le numéro de la recos (colonne A) qui est de format numérique, mais le souci est qu'on retrouve le même numéro de reco dans les autres feuilles.
      C'est pour cela que je ne peux pas donner de référence en tant que telle...
      J'espère que j'ai été un peu plus clair...

      Edi
      0
  3. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    2 solutions pour supprimer les doublons
    1)-méthode manuelle
    --sélectionner le tableau dans la feuille "Alerts_Recos"
    --dans le ruban, cliquez sur "Données"
    --dans l'onglet "Outils de données" cliquez sur "Supprimer les doublons"
    2)-méthode avec VBA, attention j'utilise la colonne K momentanément 
    Sub SuppressionDoublons()
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets("Alertes_Recos").Select
    DerLig = [A100000].End(xlUp).Row
    Range("k2:k" & DerLig).FormulaR1C1 = "=RC1&RC2&RC3&RC4&RC5&RC6"
    For i = 2 To DerLig
        Valeur = Range("K" & i).Value
        With Range("K1:K" & DerLig)
            Set x = .Find(Valeur, LookIn:=xlValues)
            If Not x Is Nothing Then
                    Depx = x.Address
                Do
                    If x.Address <> Depx And x.Row > i And Valeur = x Then x.Value = "x"
                    Set x = .FindNext(x)
                    If XRow < i Then GoTo SuppressionDesDoublons
                Loop While Not x Is Nothing And x.Address <> Depx
            End If
        End With
    Next i

SuppressionDesDoublons:
    Range("K1").FormulaR1C1 = "Tri"
    Range("K1").Select
    Selection.AutoFilter
    ActiveSheet.Range("K1:K" & DerLig).AutoFilter Field:=1, Criteria1:="x"
    NbCol = [IV1].End(xlToLeft).Column
    Range("_FilterDataBase").Offset(1, -10).Resize(, NbCol).SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Columns(11).ClearContents
End Sub

    Essayez
    Cdlt
    0
    1. edi
       
      Bonjour,

      Je ne comprends pas la deuxième partie "SuppressionDesDoublons" de la macro.
      Est-ce qu'elle fait partie de la macro ?
      0
    2. Frenchie83 Messages postés 2254 Statut Membre 339
       
      Bonjour
      OUI, c'est ce qu'on appelle une étiquette. Dans le déroulement du programme, suivant la condition testée, on lui dit d'aller lire la suite à partir de cette étiquette. C'est la cas de la ligne 
      If XRow < i Then GoTo SuppressionDesDoublons

      Par la même occasion, je viens de voir une anomalie dans ce bout de code, remplacez XRow par X.Row.
      Essayez
      Cdlt
      0
    3. edi
       
      Re,
      Voici la macro que j'ai utilisé pour supprimer les doublons. Et ça marche bien.
      Merci encore.
      Ci-dessous cette dernière:
      Sub Macro1()
      ' Macro1 Macro
      Cells.Select
      ActiveSheet.Range("$A$1:$H$7").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, _
      8), Header:=xlYes
      End Sub
      0