Sub macro3()
Dim D2$, Desti As Workbook, r As Range
D2 = Replace(ActiveWorkbook.Path, "Dossier A", "Dossier B\")
Set r = Cells(ActiveCell.Row, 1).Resize(, 4)
Set Desti = Workbooks.Open(D2 & "Classeur2.xls")
With Desti.Sheets(1)
.[B5] = r.Cells(1, 1).Value
.[D5] = r.Cells(1, 2).Value
.[B3] = r.Cells(1, 4).Value
End With
End Sub