Sub transfert_donnée()
Dim tableau, Derlig&, n%
With ActiveSheet
tableau = Array(.[C3], .[F3], .[I3], .[A12], .[A15], .[J18])
End With
For n = 1 To Worksheets.Count
With Worksheets(n)
If .Name <> ActiveSheet.Name Then
Derlig = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Cells(Derlig, "B").Resize(, UBound(tableau) + 1) = tableau
End If
End With
Next
End Sub