Bonsoir,
Pouvez vous m'aider sur le problème suivant (je tourne en rond, en rond…) : je cherche à faire un rechercher/remplacer/ajouter :

- J'ai une feuille1 avec des Réf. en col A et une feuille 2 aussi avec des Réf. tjs en col A; pour chacune des références sur les feuiles 1 et 2 j'ai des infos qui leurs corresponds qui vont de col B à H
Exemple : Feuil1 —> REF_A | INFO_1 | INFO_2 | INFO_3 | INFO_4 | INFO_5 | INFO_6 | INFO_7
Exemple : Feuil2 —> REF_A | INFO_8 | INFO_9 | INFO_7 | INFO_2 | INFO_6 | INFO_5 | INFO_1

- Mon code scan chaque ligne de la col A de la feuille 1 une à une pour retrouver la même Réf. en Feuil2 de la col A
- Si les réfs correspondent entre la feuil1 et la feuil2, je copie colle les infos de la feuil1 de A&i:H&i (i étant la ligne scanée) sur la feuil2 de A&Num_ligne:H&Num_ligne (Num_ligne étant le N° de ligne de la feuil2)
- Dans le cas où il n y a pas de réf correspondante entre la feuil1 et la feuil2 j'ai une erreur; dans ce cas la réf de la feuil1 est copié aprés la derniere réf de la feuil2 et ca la ou ca me pose problème

Pouvez vous m'aidez aussi a optimisé mon code svp.

PS : soyez indulgent ça fait qu'une semaine que je viens de commencer le vba et à intermittence.
Bref de blabla le code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Remplace()
Dim i As Integer
 
Application.ScreenUpdating = False
 
DerNum_Ligne_A = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
Plage_A_Col = Worksheets(1).Range("A1:A" & DerNum_Ligne_A)
 
DerNum_Ligne_B = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
Plage_B_Col = Worksheets(2).Range("A1:A" & DerNum_Ligne_B)
 
For i = 1 To DerNum_Ligne_A
 
      On Error GoTo ErrorHandler
 
      MaRef_A = Worksheets(1).Cells(i, 1).Value
 
      Num_Ligne = Application.Match(MaRef_A, Plage_B_Col, 0)
 
      MaRef_B = Worksheets(2).Cells(Num_Ligne, 1).Value
 
      Worksheets(1).Activate
      Set Plage_A = Range("A" & i & ":" & "H" & i)
      Plage_A.Select
      Selection.Copy
 
      Worksheets(2).Activate
      Set Plage_B = Range("A" & Num_Ligne & ":" & "H" & Num_Ligne)
      Plage_B.Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
 
      Exit Sub
 
      ErrorHandler:
 
      Worksheets(1).Range("A" & i & ":" & "H" & i).Select
      Selection.Copy
      Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
 
      Resume Next
 
 Next i
 
End Sub
le premier code que j'ai retourné dans tous les sens avant d'arriver a ce résultat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub Boucle()
Dim i As Integer
 
Application.ScreenUpdating = False
 
DernLigne1 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
MaPlage1 = Worksheets(1).Range("A1:A" & DernLigne1)
 
DernLigne2 = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
MaPlage2 = Worksheets(2).Range("A1:A" & DernLigne2)
 
For i = 1 To DernLigne1
      MaRef = Worksheets(1).Cells(i, 1).Value
 
      Ligne = Application.Match(MaRef, MaPlage2, 0)
 
      MsgBox Ligne, vbOKOnly, "Numéro de ligne"
 
      MaRef2 = Worksheets(2).Cells(Ligne, 1).Value
 
      If MaRef = MaRef2 Then
 
      Worksheets(1).Activate
      Set REFA = Range("A" & i & ":" & "H" & i)
      REFA.Select
      Selection.Copy
 
      Worksheets(2).Activate
      Set REFB = Range("A" & Ligne & ":" & "H" & Ligne)
      REFB.Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       Else
 
       Worksheets(1).Range("A" & i & ":" & "H" & i).Select
       Selection.Copy
       Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       End If
 
 Next i
 
End Sub