Problème pour copier des agences correspondant au critères

Salut le forum

J'ai essayé mais quelque chose cloche.

Je souhaite copier les agences en fonction de la valeur de la cellule k2.

En fonction de la valeur de k2(Zone I, Zone II, Zone III ou Zone IV), je souhaite que les agences correspondantes de la colonne C soit copiés et coller sur la cellule c5 de la feuille "DESTIN".

Pourquoi mon code ne fonctionne pas et comment le résoudre.

Merci

Bonjour,

Une piste sans boucle mais comme tu veux tes valeurs en C5 et que la méthode Copy() de "AutoFilter" n'accepte que comme range unique la destination A1, il te faut utiliser une feuille transitoire pour pouvoir récupérer le résultat du filtrage avec comme référence la cellule A1 pour pouvoir ensuite copier ces valeurs depuis cette feuille transitoire et les coller en C5 de la feuille de destination. Par contre, si ça ne te dérange pas d'avoir tes valeurs en B1, tu peux supprimer la feuille transitoire (voir second code)

Avec une feuille transitoire nommée "Feuil1" :

Sub Test()

    Dim FeSource As Worksheet
    Dim FeDest As Worksheet
    Dim FeTempo As Worksheet
    Dim Plage As Range
    Dim Critere As String

    Set FeSource = Worksheets("SOURCE")
    Set FeDest = Worksheets("DESTIN")
    Set FeTempo = Worksheets("Feuil1")

    With FeSource

        Set Plage = .Range(.Cells(8, 2), .Cells(.Rows.Count, 2).End(xlUp))
        Critere = .Range("K2").Value

        Plage.AutoFilter 1, Critere
        .AutoFilter.Range.EntireRow.Copy FeTempo.Range("A1")
        Plage.AutoFilter

    End With

    FeTempo.Range("B1").CurrentRegion.Copy FeDest.Range("C5")
    FeTempo.Cells.Clear

End Sub

Directement dans la feuille de destination en B1 :

Sub Test()

    Dim FeSource As Worksheet
    Dim FeDest As Worksheet
    Dim Plage As Range
    Dim Critere As String

    Set FeSource = Worksheets("SOURCE")
    Set FeDest = Worksheets("DESTIN")

    With FeSource

        Set Plage = .Range(.Cells(8, 2), .Cells(.Rows.Count, 2).End(xlUp))
        Critere = .Range("K2").Value

        Plage.AutoFilter 1, Critere
        .AutoFilter.Range.EntireRow.Copy FeDest.Range("A1")
        Plage.AutoFilter

    End With

End Sub

Bonsoir theze et le forum

Merci pour tes solutions.

Je vais opter pour la 1ère solution car le collage doit se faire sur l'autre feuille.

Les 1ers tests sont concluants.

Mercii