Sub Test()
Dim X As Range
Chemin = ThisWorkbook.Path
Set Wapp = CreateObject("Word.application")
Wapp.Visible = True
Set MonDoc = Wapp.Documents.Add(DocumentType:=0)
For Each X In Range("C1:" & Range("C65536").End(xlUp).Address)
If X.Offset(0, 1).Value = "Oui" Then
With Wapp.Selection.Font
.Size = X.Font.Size
.Bold = X.Font.Bold
.Name = X.Font.Name
If X.Font.Underline < 0 Then
.Underline = 0
Else
.Underline = X.Font.Underline
End If
.Italic = X.Font.Italic
.Color = X.Font.Color
End With
Wapp.Selection.TypeText Text:=X & ""
Wapp.Selection.TypeParagraph
End If
Next
MonDoc.SaveAs Filename:=Chemin & "\Test.doc"
Wapp.Quit
Set Wapp = Nothing
End Sub