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 |
Partager