Sub travdem()
Dim Cellule1 As Range, Cellule2 As Range
Dim Nomfeuille1 As String, Nomfeuille2 As String, Nomfeuille3 As String
Dim Col1 As String, Col2 As String, Col3 As String
Dim Dl1 As Long
'parametre
Nomfeuille1 = "Feuille A"
Nomfeuille2 = "Feuille B"
Nomfeuille3 = "recap"
Col1 = "A"
Col2 = "b"
Col3 = "A"
With Sheets(Nomfeuille3)
For Each Cellule1 In Sheets(Nomfeuille1).Range(Col1 & "3:" & Col1 & Sheets(Nomfeuille1).Range(Col1 & Sheets(Nomfeuille1).Rows.Count).End(xlUp).Row)
For Each Cellule2 In Sheets(Nomfeuille2).Range(Col2 & "3:" & Col2 & Sheets(Nomfeuille2).Range(Col2 & Sheets(Nomfeuille2).Rows.Count).End(xlUp).Row)
If Cellule1 = Cellule2 Then
'if Cellule1 = Cellule2 and Cellule1.Offset(0, 1) = Cellule2.Offset(0, ?) Then ' si on rajoute les prénoms
Dl1 = .Range(Col3 & .Rows.Count).End(xlUp).Row + 1
.Range("a" & Dl1) = Cellule1
.Range("b" & Dl1) = Cellule1.Offset(0, 2)
.Range("c" & Dl1) = Cellule2.Offset(0, 1)
Exit For
End If
Next Cellule2
Next Cellule1
End With
End Sub