Sub t()
Sheets(2).Range("f1").CurrentRegion.ClearContents
Sheets(2).Range("f1") = "Marié"
Sheets(2).Range("g1") = "Fiancé"
Sheets(2).Range("h1") = "Célibataire"
With Sheets(1)
For i = 2 To 8
For j = 6 To 8
If .Cells(i, 2) = Sheets(2).Cells(1, j) Then
Sheets(2).Cells(65000, j).End(xlUp).Offset(1, 0) = .Cells(i, 1)
Exit For
End If
Next
Next
End With
End Sub