Rechercher et copier,coller dans une autre feuille en boucle
cool185
Messages postés
25
Statut
Membre
-
cool185 Messages postés 25 Statut Membre -
cool185 Messages postés 25 Statut Membre -
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
Cordialement
merci d'avance
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
-
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 -
