Rebonjour à tous
Merci encore à ceux qui m'ont aider sur la création d'une liste d'équivalences!
Je commence à comprendre un peu la structure VBA mais c'est pas encore ça !

J'essaye de rajouter une fonctionnalité qui serait de copier vers un onglet existant si il n'y a pas de match dans la liste d'équivalences...





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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Sub Remplacement_IP()
'Déclarations =============================
Dim Cl_L As Workbook
Dim Cl As Workbook
Dim F_L As Worksheet
Dim F As Worksheet
Dim Cel_L As Range
Dim Cel As Range
Dim Flg As Boolean
Dim Plage_T As String
'Dim i As Integer
'MEI ======================================
Set Cl = ActiveWorkbook
Set F = ActiveSheet
Set F_Inco = Cl.Sheets(4)
'Ouverture classeur liste si pas ouvert ----
Flg = True
For Each Cl_L In Workbooks
    If Cl_L.Name = "Liste IP - source.xls" Then
        Flg = False
        Exit For
    End If
Next Cl_L
If Flg Then
    Workbooks.Open Filename:=ActiveWorkbook.Path & "\Liste IP - source.xls"
    Set Cl_L = ActiveWorkbook
End If
'si macro depuis classeur liste => sortie
If Cl.Name = Cl_L.Name Then Exit Sub
Set F_L = Cl_L.Sheets(1)
'Définition de la plage de remplacement --------------
Plage_T = F.Range("F1:F" & _
F.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Address(0, 0) & "," & _
F.Range("H1:H" & F.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Address(0, 0)
'Remplacement ===============================
 
For Each Cel In F.Range(Plage_T).Cells
    If Not (IsEmpty(Cel)) Then
        Flg = True
        For Each Cel_L In F_L.UsedRange.Columns("A").Cells
            If Cel_L = Cel Then
                Cel = Cel_L.Offset(0, 1)
                Flg = False
                Exit For
            End If
        Next Cel_L
       If Flg Then
            If Cel.Interior.ColorIndex <> xlNone Then
 
            Else
                Cel.Interior.ColorIndex = 3
            End If
 
 
 
        Else
          Cel.Interior.ColorIndex = Cel_L.Interior.ColorIndex
        End If
 
 
 
    End If
 
Next Cel
Cl_L.Close
End Sub
If Flg Then
If Cel.Interior.ColorIndex <> xlNone Then

Else
Cel.Interior.ColorIndex = 3
Je pense qu'ici il serait possible de copier la cellule vers un nouvel onglet... j'ai essayé pendant une petite heure de trouver comment faire mais pour moi le problème c'est que c'est un range et que je veux copier vers une cellule... Est il possible de faire Cast ? si vous avez une autre idée n'hésitez pas!


Merci d'avance !