Sub es()
Dim t(), t1(), x As Long, i As Long
Application.ScreenUpdating = 0 'pas de mise a jour ecran
t = Feuil8.Range("a15:aw" & Feuil8.Cells(Rows.Count, 1).End(3).Row)
ReDim t1(1 To UBound(t), 1 To 49)
For i = 1 To UBound(t)
x = x + 1
t1(x, 1) = t(i, 36): t1(x, 2) = t(i, 1): t1(x, 3) = t(i, 3): t1(x, 4) = t(i, 6)
t1(x, 5) = t(i, 49): t1(x, 6) = t(i, 2): t1(x, 7) = t(i, 35)
t1(x, 8) = t(i, 10) & " " & t(i, 11) & Chr(10) & t(i, 12)
If t(i, 14) = "" Then
t1(x, 9) = t(i, 15) & " " & t(i, 16) & " " & t(i, 17) & " " & _
t(i, 18) & Chr(10) & t(i, 19) & " " & t(i, 20) & " " & t(i, 21)
Else
t1(x, 9) = t(i, 14) & Chr(10) & t(i, 15) & " " & t(i, 16) & " " & t(i, 17) & " " & _
t(i, 18) & Chr(10) & t(i, 19) & " " & t(i, 20) & " " & t(i, 21)
End If
If t(i, 23) = "" Then
t1(x, 10) = t(i, 24) & " " & t(i, 25) & " " & t(i, 26) & " " & _
t(i, 27) & " " & t(i, 28) & Chr(10) & " " & t(i, 29) & " " & t(i, 30)
Else
t1(x, 10) = t(i, 23) & Chr(10) & t(i, 24) & " " & t(i, 25) & " " & t(i, 26) & " " & _
t(i, 27) & " " & t(i, 28) & Chr(10) & " " & t(i, 29) & " " & t(i, 30)
End If
t1(x, 11) = t(i, 9): t1(x, 12) = t(i, 22): t1(x, 13) = t(i, 33): t1(x, 14) = t(i, 43): t1(x, 15) = t(i, 44)
Next i
Workbooks.Open Filename:="C:\Users\leti\Desktop\reception.xls" 'chemin complet
Workbooks("reception.xls").Sheets("Feuil2").Cells(2, 1).Resize(x, 15) = t1 'copy en feuil2 cells=a2
ActiveWorkbook.Save 'sauvegarde le fichier
ActiveWorkbook.Close 'le ferme
MsgBox "copy ok!!"
End Sub