Option Explicit
Public Derlig As Long, DerCol As Long, Cell As Range
Sub Transfert()
Dim Dico As Object, F As Worksheet
Set Dico = CreateObject("Scripting.Dictionary")
For Each F In Worksheets
If LCase(F.Name) <> "accueil" Then 'excepté celle-ci !
Derlig = F.Cells(Rows.Count, 3).End(xlUp).Row
For Each Cell In F.Range("C7", F.Cells(Derlig, 3))
If Cell <> "" Then Dico(Cell.Value) = ""
Next
End If
Next
If Dico.Count > 0 Then
With Sheets("ACCUEIL"): .[I4].Resize(Dico.Count) = Application.Transpose(Dico.keys): End With
End If
Set F = Nothing: Set Dico = Nothing
End Sub