• Initiateur de la discussion Initiateur de la discussion Moreno076
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Moreno076

XLDnaute Impliqué
Bonsoir.

Ci-joint j'ai un fichier excel avec 2 feuilles.

La première contient une colonne nommée "code".
Je souhaiterais que sur une troisième feuille, la ligne entière correspondant au code de la feuille1 soit recherchée dans la feuille 2. et inscrite entière.

Pouvez-vous m'aider svp.
 
Dernière édition:
Re : Comparaison

Re,

Là je crois qu'il va falloir passer par une matricielle pour ma colonne A, et moi, les matricielles après 23:50, j'ai un peu de mal 😉

Mais je crois que JM rôde dans le coin, (il est privé de télé, car il a répondu à un demandeur qui n'avait pas de pièces sur lui 😉 ) et s'il voit ce fil, il va vous sortir un code VBA aux p'tits oignons 🙂
 
Re : Comparaison

Re

Comme Victor21 m'a gentiment invité ici, alors voici
(test OK sur le fichier joint dans le message 1)
et sur ce je m'en retourne sous la couette m'en mettre plein les esgourdes 😉
Code:
Sub JoteMonPyjamaPourVictor21()
Feuil2.Range("E1:E2").Value = Feuil1.Range("A1:A2").Value
Feuil2.Range("A1:C3").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Feuil2.Range( _
        "E1:E2"), CopyToRange:=Feuil3.Range("A1"), Unique:=False
End Sub
 
Re : Comparaison

Bonjour Moreno076;Victor21;Staple1600; le Forum

Voici une autre proposition.

Code:
Sub ChercherEtCopierTout()

 Dim f As Worksheet, f2 As Worksheet, f3 As Worksheet
 Dim After As Range, rg As Range
 Dim premiere As String
 
 Dim i As Long, ligne3 As Long
 
    Set f = ThisWorkbook.Worksheets("Feuil1")
    Set f2 = ThisWorkbook.Worksheets("Feuil2")
    Set f3 = ThisWorkbook.Worksheets("Feuil3")
    Dim What As Variant
    
    ligne3 = 1
    f3.Cells.Clear
    
    Set After = f2.Cells(f2.Rows.Count, 1)
    
    For i = 2 To f.Range("A" & f.Rows.Count).End(xlUp).Row
        
        What = f.Cells(i, 1)
        Set rg = f2.Columns(1).Find(What:=What, After:=After, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not rg Is Nothing Then
            premiere = ""
            While premiere <> rg.Address
                premiere = rg.Address
                
                ligne3 = ligne3 + 1
                f2.Rows(rg.Row).Copy f3.Cells(ligne3, 1)
                
                Set rg = f2.Columns(1).Find(What:=What, After:=rg, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                
            Wend
        End If
        
    Next
    
End Sub

Cordialement

Docmarti
 
Re : Comparaison

Bon bah je n'y arrive pas :-( Je mets le fichier en PJ.

Le but est de retrouver à travers la colonne CODE de la feuille le reste de la ligne dans la feuille 2 et qui se recopie entièrement feuille 3.

Merci !
 
Dernière édition:
Re : Comparaison

Bonjour,

Solution VBA avec le filtre avancé (élaboré) comme l'a bien vu Staple1600 :

Code:
Sub Filtrer()
'Feuil1 Feuil2 Feuil3 sont les CodeNames des feuilles
Dim ad$
ad = Feuil1.[A1].CurrentRegion.Address(, , , True)
With Feuil2 'CodeName
  .[F2] = "=COUNTIF(" & ad & ",A2)"
  .[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, .[F1:F2]
  Feuil3.Cells.Clear 'RAZ
  .[A1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Feuil3.[A1]
  .[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, ""
  .[F2] = ""
End With
Feuil3.Activate
End Sub
Fichier joint.

Edit : ajouté Feuil3.Cells.Clear 'RAZ

A+
 

Pièces jointes

Dernière édition:
Re : Comparaison

Bonsoir à tous


Job75
J'avais certes vu l'AdvancedFilter (qui au passage, Moreno76 fonctionnait aussi dans mon code VBA de 00h11) 😉
Mais ton code peaufiné est au moins aussi beau que mon pyjama 😉
(cf mon message précédent)
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
17
Affichages
838
D
  • Question Question
Réponses
5
Affichages
250
Didierpasdoué
D
Retour