Public Sub Arrange()
Dim Ws As Worksheet, Ws1 As Worksheet, L As Long, Li As Long, C As Long, nbC As Long, a(), x As Long, y
Set Ws1 = Worksheets("Feuil1")
L = Ws1.Range("b65000").End(xlUp).Row
nbC = Ws1.Range("B1").End(xlToRight).Column
a = Ws1.Range("B1:" & Ws1.Cells(2, nbC).Address).Value
Ws1.Range("B3:" & Ws1.Cells(L, nbC).Address).ClearContents
L = 0
For C = 1 To UBound(a, 2)
L = L + 1
Ws1.Cells(L, 1).Value = a(1, C)
Ws1.Cells(L, 2).Value = a(2, C)
Next C
Ws1.Range("C1:" & Ws1.Cells(2, nbC).Address).ClearContents
L = Ws1.Range("A65000").End(xlUp).Row
a = Ws1.Range("A1:C" & L).Value
For L = 1 To UBound(a, 1)
If Not IsError(Evaluate("='" & CStr(a(L, 1)) & "'!A1")) Then 'teste si feuille existe,voir plus bas un autre code
Set Ws = Worksheets(CStr(a(L, 1)))
For Li = 1 To 65000
If Ws.Range("I" & Li) <> "" Then a(L, 3) = Ws.Range("I" & Li): Exit For
Next Li
End If
Next L
Ws1.Range("A1").Resize(UBound(a, 1), UBound(a, 2)) = a
x = InputBox("Entrer une valeur,svp") ' de 2 chiffres
For L = 1 To UBound(a, 1)
If IsError(Evaluate("='" & CStr(a(L, 1)) & "'!A1")) = True Then 'teste si feuille existe
'action.Exemple: msgbox "Feuille" & a(L, 1) & " n'existe pas"'tu supprimes 'action.Exemple: pour avoir le message
Else
y = a(L, 2) - a(L, 3)
If y <= x Then
Ws1.Cells(L, 3).Interior.ColorIndex = 6
End If
End If
Next
End Sub