Macro excel Recherche

Sub chercher_D15()
Dim occ
Dim c As Range
Dim lig1 As Long, lig2 As Long

Application.ScreenUpdating = False
With Sheets(1)
occ = .Range("D15")
Range("C21:C65536").ClearContents
End With

With Sheets(2)
If Application.CountIf(.Columns(1), occ) = 0 Then  'column(1) 1°colonne: colA
    MsgBox "valeur inconnue"
    Exit Sub
End If
'd'après aide Excel sur fonction Find
With .Range("A:A")
    Set c = .Find(occ, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        lig1 = 21
        Do
            lig2 = c.Row
            Sheets(1).Cells(lig1, 3) = .Cells(lig2, 4)  '4 4°colonne:colD
            lig1 = lig1 + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End With

end sub