Synthetiser des données de plusieurs onglets

Dim Col As String
'parametre
' pour boucler sur la colonne 1
Nomfeuille1 = "Synthèse"
Nomfeuille3 = "Totaux"
Nomfeuille2 = "Rejets"
Col = "A"
With Sheets(Nomfeuille1)

For Each Cellule In .Range(Col & "2:" & Col & .Range(Col & .Rows.Count).End(xlUp).Row)
Dl1 = RechercheLigne(Nomfeuille2, "a", 1, 2, Cellule.Value, Cellule.Offset(0, 1))
If Dl1 > 0 Then _
Cellule.Offset(0, 2) = Sheets(Nomfeuille2).Range("g" & Dl1)
Dl1 = RechercheLigne(Nomfeuille3, "a", 1, 2, Cellule.Value, Cellule.Offset(0, 1))
If Dl1 > 0 Then _
Cellule.Offset(0, 3) = Sheets(Nomfeuille3).Range("g" & Dl1)

Next Cellule

    

End With
End Sub


'fonction pour rechercher la ligne corrrespondante
Private Function RechercheLigne(Nomfeuille As String, Colonne As String, offset1 As Byte, Lignedep As Long, valeur1 As String, valeur2 As String)
Dim Cel As Range
Dim FirstAddress As String

With Worksheets(Nomfeuille).Range(Colonne & Lignedep & ":" & Colonne & (Worksheets(Nomfeuille).Range(Colonne & Worksheets(Nomfeuille).Rows.Count).End(xlUp).Row))
    Set Cel = .Find(valeur1, LookIn:=xlValues)
    If Not Cel Is Nothing Then
        FirstAddress = Cel.Address
        Do
            If valeur2 <> "" Then
                If valeur2 = Cel.Offset(0, offset1) Then
                    RechercheLigne = Cel.Row
                    Exit Function
                End If
            Else
                RechercheLigne = Cel.Row
                Exit Function
            End If
            Set Cel = .FindNext(Cel)
        Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
    End If
End With
RechercheLigne = 0
End Function

Dl1 = RechercheLigne(Nomfeuille2, "a", 1, 2, cellule.Value, cellule.Offset(0, 1))