Rechercher et copier,coller dans une autre feuille en boucle [Fermé]

Signaler
Messages postés
16
Date d'inscription
dimanche 26 décembre 2010
Statut
Membre
Dernière intervention
28 octobre 2014
-
Messages postés
16
Date d'inscription
dimanche 26 décembre 2010
Statut
Membre
Dernière intervention
28 octobre 2014
-
Bonsoir à tous j'ai besoin de votre aide s'il vous plait,
voila j'ai deux tableaux dans un même classeur contenant tout deux une colonne zip.Je voudrais chercher la première valeur de la feuil 2 dans la feuil1 et si elle existe dans la feuil 2 alors,la ligne est copier puis coller dans la feuil "final" et cela ainsi de suite pour toutes les valeur de la colonne zip.
Aider moi à réaliser cela s'il vous plait

voici mon code

Sub TRAITEMENT()

    Range("A2").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Columns("A:A").Select
    Selection.Find(What:="90001", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("2:2").Select
    Selection.Copy
    Sheets("FINAL").Select
    Rows("2:2").Select
    ActiveSheet.Paste
End Sub


Cordialement
merci d'avance

2 réponses

Messages postés
15725
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
11 avril 2021
1 481
Bonjour,

une facon de faire pas trop complexe:

Sub TRAITEMENT()
Dim Tzipf1, Tzipf2 As Range
'figeage ecran
Application.ScreenUpdating = False
'raz contenu cellules
Worksheets("Final").Cells.ClearContents
'mise en memoire colonne zipf1
With Worksheets("feuil1")
'derniere cellule non vide colonne A
derlig = .Range("A" & Rows.Count).End(xlUp).Row
Tzipf1 = .Range("A2:A" & derlig)
End With

With Worksheets("feuil2")
'derniere cellule non vide colonne A
derlig = .Range("A" & Rows.Count).End(xlUp).Row
'mise en memoire colonne zipf2
Set Tzipf2 = .Range("A2:A" & derlig)
'nombre de valeurs
FinTzipf1 = UBound(Tzipf1)
'boucle de recherche et copie si trouve
For Point = 1 To FinTzipf1
'test si infos zipf1 dans zipf2
If Application.CountIf(Tzipf2, Tzipf1(Point, 1)) = 1 Then
lig = 1
'recherche ligne infos
lig = .Columns(1).Find(Tzipf1(Point, 1), .Cells(lig, 1), , xlWhole).Row
'premier cellule vide vide colonne A
derlig = Worksheets("Final").Range("A" & Rows.Count).End(xlUp).Row + 1
'copie ligne trouvee
.Rows(lig).Copy Worksheets("Final").Range("A" & derlig)
End If
Next Point
End With
'defigeage ecran
Application.ScreenUpdating = True
End Sub
Messages postés
16
Date d'inscription
dimanche 26 décembre 2010
Statut
Membre
Dernière intervention
28 octobre 2014
1
Merci à toi f89400 de tout coeur ça marche super