petit problème dans le code mais ou?

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range(col1 & lidep1 & "a8:a" & .Range("a65536").End(xlUp).Row)
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
For Each d In .Range("c" & cellule.Row & ":ag" & cellule.Row)
'For Each d In .Range(Cells(cellule.Row, 6), Cells(cellule.Row, 33))
   'd.Select
   If d <> "" Then Worksheets(w1).Cells(ActiveCell.Row, col) = d
    col = col + 1
Next d
End With
   Worksheets(w1).Activate
End Sub

For Each d In .Range([COLOR="Red"]"f"[/COLOR] & cellule.Row & ":ag" & cellule.Row)

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
Dim lig As Long
Dim val1 As Variant

col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range("a8:a" & .Range("a65536").End(xlUp).Row)
End With
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
lig = cellule.Row

With Sheets(w1)
Set plage = .Range("c9:ag9")
For Each cellule In plage
   val1 = recherche("Base_Soignants", CStr(cellule.Value), CStr(cellule.Offset(2, 0).Value), lig)
   .Cells(ActiveCell.Row, cellule.Column) = val1
Next cellule
End With
   Worksheets(w1).Activate
End Sub
Private Function recherche(£feul As String, £val1 As String, £val2 As String, £lig As Long)
Dim £plage As Range
Dim £cellule As Range
With Sheets(£feul)
recherche = ""
Set £plage = .Range("f1:ag1")

For Each cellule In £plage
     If CStr(cellule.Value) = £val1 And LCase(CStr(cellule.Offset(1, 0).MergeArea(1))) = £val2 Then
     recherche = cellule.Offset(£lig - 1, 0).Value
     Exit Function
     End If
Next cellule

End With
End Function

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
Dim lig As Long
Dim val1 As Variant

col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range("a8:a" & .Range("a65536").End(xlUp).Row)
End With
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
lig = cellule.Row

With Sheets(w1)
Set plage = .Range("c9:ag9")
For Each cellule In plage
   val1 = recherche("Base_Soignants", CStr(cellule.Value), CStr(cellule.Offset(2, 0).Value), lig)
   .Cells(ActiveCell.Row, cellule.Column) = val1
Next cellule
End With
   Worksheets(w1).Activate
End Sub
Private Function recherche(£feul As String, £val1 As String, £val2 As String, £lig As Long)
Dim £plage As Range
Dim £cellule As Range
With Sheets(£feul)
recherche = ""
Set £plage = .Range("f1:ag1")

For Each cellule In £plage
     If CStr(cellule.Value) = £val1 And LCase(CStr(cellule.Offset(1, 0).MergeArea(1))) = £val2 Then
     recherche = cellule.Offset(£lig - 1, 0).Value
     Exit Function
     End If
Next cellule

End With
End Function