Option Explicit
Sub Cp2()
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim der1 As Long
Dim der2 As Long
Dim c As Range
Dim res As Variant
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
der1 = ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
If der1 = 2 Then Exit Sub
Workbooks.Open Filename:=wkb1.Path & "\fichier1.xlsm"
Set wkb2 = ActiveWorkbook
wkb1.Activate
For Each c In wkb1.Sheets(1).Range("C3:C" & der1)
res = Application.Match(c, wkb2.Sheets(1).Range("C3:C500"), 0)
If IsError(res) Then
der2 = wkb2.Sheets(1).Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
wkb2.Sheets(1).Range("B" & der2 & ":I" & der2).Value = wkb1.Sheets(1).Range("B" & c.Row & ":I" & c.Row).Value
End If
Next c
wkb2.Activate
wkb2.Close savechanges:=True
Application.ScreenUpdating = True
End Sub