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

Y compris Power BI, Power Query et toute autre question en lien avec Excel
z
zombe
Membre dévoué
Membre dévoué
Messages : 784
Appréciation reçue : 1
Inscrit le : 28 juin 2011
Version d'Excel : 2007 fr

Message par zombe » 6 février 2018, 23:04

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
Copier_agence.xlsm
(19.11 Kio) Téléchargé 8 fois
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 7 février 2018, 07:24

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
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
z
zombe
Membre dévoué
Membre dévoué
Messages : 784
Appréciation reçue : 1
Inscrit le : 28 juin 2011
Version d'Excel : 2007 fr

Message par zombe » 7 février 2018, 19:03

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 ::D
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message