Try then following.
-Merjet

Sub InsertRepresentativesInitials()
Dim ClasseurRep As Workbook
Dim Numdpt As String
Dim Colonne As Variant
Dim c As Range
Dim iEnd As Long

Set ClasseurRep = Workbooks.Open("C:\TPExcel\Representants.xls")
On Error Resume Next
iEnd = ThisWorkbook.Sheets("Feuil1").Range("D4").End(xlDo wn).Row
For Each c In ThisWorkbook.Sheets("Feuil1").Range("D4:D" & iEnd)
Numdpt = Left(c.Value, 2)
Colonne = ""
Colonne =
ClasseurRep.Sheets(1).Range("A4:F20").Find(What:=N umdpt, _
LookIn:=xlFormulas, LookAt:=xlWhole).Address
If Colonne < "" Then
Colonne = CInt(Range(Colonne).Column)
c.Offset(0, -1) = ClasseurRep.Sheets(1).Cells(3,
Colonne).Comment.Text
End If
Next c
ClasseurRep.Close
Set ClasseurRep = Nothing
End Sub