rechercher et copier,coller dans une autre feuille en boucle Fermé

Question

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

f894009 · Answer

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 = TrueEnd Sub

cool185 · Answer

Merci à toi f89400 de tout coeur ça marche super

Rechercher et copier,coller dans une autre feuille en boucle

2 réponses

Discussions similaires

Newsletters