RECHERCHER - Copier et coller

Bonjour,

J'ai commencer un macro qui permet de rechercher une valeur donnée sur une autre feuille en vérifiant par ligne dans 5 colonne différente , puis la copier et la coller sur une autre feuille. le problème c'est quel ne marche pas et je ne sais pas pourquoi, j'ai chercher sur plusieurs forum différent mais impossible de trouver.

Pouvez-vous m'aider ?

Voici mon code :

Sub RECHERCHE_2()
Dim cel As Range
Dim valcherch As String
Dim FL1, FL2 As Worksheet
Dim NoLig As Long
Dim derlig As Integer

Set FL1 = Worksheets("Suivi")
Set FL2 = Worksheets("FRN")

    Application.ScreenUpdating = False

    valcherch = FL2.Range("G1")

    With FL1

        derlig = .Range("U" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A3:U" & derlig)
    End With

    derlig = 0

    For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
    If FL1.Cells(NoLig, 13).Value = valcherch Then

    With FL2

    For Each cel In plage
        If cel <= valcherch Then
            derlig = .Range("M" & Rows.Count).End(xlUp).Row + 1

            If derlig = 3 Then
                derlig = 287
            End If

            cel.EntireRow.Copy .Range("A6" & derlig)

        End If
    Next cel
   End With
    Application.ScreenUpdating = True

    ElseIf FL1.Cells(NoLig, 15).Value = valcherch Then

     With FL2
  For Each cel In plage
        If cel <= valcherch Then
            derlig = .Range("Q" & Rows.Count).End(xlUp).Row + 1

            If derlig = 3 Then
                derlig = 286
            End If

            cel.EntireRow.Copy .Range("A6" & derlig)

        End If
    Next cel
    End With
    Application.ScreenUpdating = True

    ElseIf FL1.Cells(NoLig, 17).Value = valcherch Then
     With FL2
    For Each cel In plage
        If cel <= valcherch Then
            derlig = .Range("S" & Rows.Count).End(xlUp).Row + 1

            If derlig = 3 Then
                derlig = 257
            End If

            cel.EntireRow.Copy .Range("A6" & derlig)

        End If
    Next cel
    End With
    Application.ScreenUpdating = True

       ElseIf FL1.Cells(NoLig, 19).Value = valcherch Then
     With FL2
   For Each cel In plage
        If cel <= valcherch Then
            derlig = .Range("U" & Rows.Count).End(xlUp).Row + 1

            If derlig = 3 Then
                derlig = 95
            End If

            cel.EntireRow.Copy .Range("A6" & derlig)

        End If
    Next cel
    Application.ScreenUpdating = True
    End With
    Else

    Exit For

End If

Next

End Sub

En vous remerciant d'avance de votre réponse,

Cordialement.

Bonjour,

et ton fichier ?

et pourquoi ne pas utiliser un filtre avancé ?

    Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("critères"), _
        CopyToRange:=Range("extraction"), Unique:=False

un exemple ...

Merci pour ta réponse,

Mais je n'ai pas tous compris ce que tu a dit ?

Comme demandé je te joint mon fichier.

En te remerciant d'avance pour ton aide,

Cordialement.

Ton fichier comporte de nombreux liens inactivables, difficile à re-travailler ... je préfère te renvoyer vers ceci :

http://boisgontierjacques.free.fr/pages_site/FiltreElabore.htm

Voici

Sub test_recopie()

    Worksheets("Suivi").Range("A2:AC499").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("A1:AC6"), _
        CopyToRange:=Range("A14"), Unique:=False

End Sub

Amélioration dans le code :

Sub selectionner()

    ' variables
    Set crit = ActiveSheet.ListObjects("Tableau2").Range        ' tableau contenant les critères (plusieurs lignes possibles = OU)
    Set donnees = Sheets("Suivi").ListObjects("Tableau1").Range ' tableau contenant les données
    Set dest = ActiveSheet.Range("A10")                         ' zone de recueil de la sélection

    ' traitement
    dest.CurrentRegion.Clear
    donnees.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=crit, _
        CopyToRange:=dest, Unique:=False

End Sub

Par ailleurs,

> Les zones nommées Extraireet Criteressont données par excel. A vérifier lors de la mise au point.

> Le résultat ne peut apparaître que dans la feuille qui la lancé la macro.

Bonjour Steelson,

Merci pour ton aide , ton code marche très bien le problème c'est que si je change de fournisseur dans le nom et que je clique sur rechercher , sa ne marche pas , ça marche que la première fois.

Par contre, je n'ai pas compris ton code nommer "sélectionner" , a quoi sert-il ? Qu'Est-ce que "tableau 1" et "Tableau 2" ?

En te remerciant d'avance de ta réponse,

Cordialement.

Envoie ton fichier complet en MP si besoin. Encore que comme il y a des liaisons !!

J'ai testé et re-testé chez moi, cela fonctionne bien et je m'en suis fait un modèle que voici du reste !

Regarde d'abord en faisant Formule>Gestionnaire de noms si les noms Extraireet Criteressans accent existent ?

J'avoue que quand ça marche c'est génial, mais cela me semble pointu en réglage ! mais c'est hyper-performant.

Merci , ça marche super