vitesse d'execution d'une macro

bonjour le forum.

j'ai une macro qui me permet sur deux feuille différente de recuperer des codes mais aussi des valeurs si les cellules de la ligne 80 sont >0.
mon problème est que sa vitesse d'execution est relativement longue
voici la macro
Private Sub Worksheet_Activate()
Dim nbMatieres As Integer, cpt1 As Integer, org As Variant, dest As Variant

'Application.ScreenUpdating = False


Set org = Sheets("calcul besoin")
Set dest = Sheets("besoin")
nbMatieres = org.Range("IV80").End(xlToLeft).Column
dest.Range("a3:j200").ClearContents

For cpt1 = 8 To nbMatieres
If org.Cells(80, cpt1) > 0 Then
org.Cells(80, cpt1).Copy
dest.Range("c65536").End(xlUp)(2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _

org.Cells(6, cpt1).Copy
dest.Range("b65536").End(xlUp)(2).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False

org.Cells(5, cpt1).Copy
dest.Range("a65536").End(xlUp)(2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
'eclatement semaine


org.Cells(82, cpt1).Copy
dest.Range("d65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(83, cpt1).Copy
dest.Range("e65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(84, cpt1).Copy
dest.Range("f65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(85, cpt1).Copy
dest.Range("g65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(86, cpt1).Copy
dest.Range("h65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(87, cpt1).Copy
dest.Range("i65536").End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(88, cpt1).Copy
dest.Range("j65536").End(xlUp)(2).PasteSpecial Paste:=xlValues



End If
Next cpt1



Application.CutCopyMode = False

End Sub
peut -on accelerer sa vitesse

merci de votre aide

a+