Salut Danval,
premier jet...
La mise à jour se fait directement à l'ouverture.
Private Sub Workbook_Open()
'
Dim sWkT As Worksheet, sWk As Worksheet
Dim tRAP, tGBM, tSYB, tCCAS, tARCH
'
Application.ScreenUpdating = False
'
Set sWkT = Worksheets("Rapport 1")
tRAP = sWkT.Range("I3:W" & sWkT.Range("I" & Rows.Count).End(xlUp).Row).Value
tGBM = Worksheets("GBM").Range("F2:O" & Worksheets("GBM").Range("F" & Rows.Count).End(xlUp).Row).Value
tSYB = Worksheets("SYBERT").Range("F2:O" & Worksheets("SYBERT").Range("F" & Rows.Count).End(xlUp).Row).Value
tCCAS = Worksheets("CCAS").Range("F2:O" & Worksheets("CCAS").Range("F" & Rows.Count).End(xlUp).Row).Value
tARCH = Worksheets("+ARCHEO").Range("F2:O" & Worksheets("+ARCHEO").Range("F" & Rows.Count).End(xlUp).Row).Value
'
On Error Resume Next
For x = 1 To UBound(tRAP, 1)
If tRAP(x, 1) <> "" Then
iOK = 0
For y = 1 To 4
For Z = 1 To UBound(Choose(y, tGBM, tSYB, tCCAS, tARCH), 1)
If Choose(y, tGBM(Z, 1), tSYB(Z, 1), tCCAS(Z, 1), tARCH(Z, 1)) = tRAP(x, 1) Then
iOK = 1
For w = 11 To 15
If Choose(y, tGBM(Z, w - 5), tSYB(Z, w - 5), tCCAS(Z, w - 5), tARCH(Z, w - 5)) <> tRAP(x, w) Then _
Set sWk = Worksheets(Choose(y, "GBM", "SYBERT", "CCAS", "+ARCHEO")): _
sWk.Range("K" & Z + 1).Resize(1, 5).Copy Destination:=sWkT.Range("S" & x + 2).Resize(1, 5): _
iOK = 2: _
Exit For
Next
If iOK > 0 Then Exit For
End If
Next
If iOK = 2 Then Exit For
Next
End If
Next
On Error GoTo 0
'
Application.ScreenUpdating = True
'
End Sub
A+