Option Explicit
Sub Bulk()
Dim WsS As Worksheet, WsC As Worksheet
Dim C As Range, Cel As Range, PlageS As Range
Dim firstAddress As String
Dim LigneAjout As Long
Dim NouvLigne As Boolean
Application.ScreenUpdating = False
Set WsS = Sheets("IMP") 'Feuille source (IMP)
Set WsC = Sheets("Report") 'Feuille cible (Report)
Set PlageS = WsS.Range("B2:B" & WsS.Range("B2").End(xlDown).Row)
For Each C In PlageS
NouvLigne = True
Set Cel = WsC.Columns("B:B").Find(C.Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not Cel Is Nothing Then
firstAddress = Cel.Address
Do
'Si les valeurs dans les colonnes C sont identiques _
on effectue la mise à jour
If Cel.Offset(0, 1) = C.Offset(0, 1) Then
C.Offset(0, 2).Resize(1, 42).Copy Cel.Offset(0, 2)
NouvLigne = False
Exit Do
End If
Set Cel = WsC.Columns("B:B").FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> firstAddress
End If
If NouvLigne Then
LigneAjout = WsC.Range("B2").End(xlDown).Row + 1
C.Offset(0, -1).Resize(1, 45).Copy WsC.Range("A" & LigneAjout)
End If
Next C
Set Cel = Nothing: Set PlageS = Nothing: Set WsC = Nothing: Set WsS = Nothing
Application.ScreenUpdating = True
End Sub