VBA cellen kopiëren en automatisch ordenen van groot naar klein

[Helpzoekende]

Beste

Er wordt van mij gevraagd om een geautomatiseerd rekenblad in excel te maken. Dit heb ik gedaan ik heb echter het probleem dat het verwerken te lang duurt volgens de hoofdverantwoordelijke.

Met behulp van VBA kopieer ik cellen naar een andere locatie, en deze worden dan automatisch van groot naar klein gerangschikt. Ik kan dit echter niet in de cellen zelf laten doen omdat in deze cellen formules staan. Hiervoor heb ik een knop aangemaakt die wanneer men hier op klikt dit proces zal starten. Onderstaand vind u een gedeelte van de bewerking. Ik zoek een manier om deze korter te maken zodat de verwerking sneller verloopt.

Hopelijk kunnen jullie mij helpen.
Alvast bedankt



Range("AM2:AQ8761").Copy
Range("AY3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort.SortFields.Add Key:=Range( _
"AY3"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort
.SetRange Range("AY3:AY8762")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort.SortFields.Add Key:=Range( _
"AZ3"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("berekening aantal draaiuren").Sort
.SetRange Range("AZ3:AZ8762")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Bekijk bijlage Map1.xlsm

 

[snb]

Jij kunt ons helpen door VBA-code tussen code markeringen (code tags) te plaatsen.
Een voorbeeldbestand kan ook een versnellende faktor zijn.

 

[Helpzoekende]

Jij kunt ons helpen door VBA-code tussen code markeringen (code tags) te plaatsen.
Een voorbeeldbestand kan ook een versnellende faktor zijn.

Bedankt voor de spoedige reactie. Ik heb even een heel eenvoudig voorbeeld gemaakt maar als men dit op een kortere manier zou kunnen schrijven dan zou ik de rest zelf wel moeten kunnen.
Het voorbeeld heb ik bij in het bericht gevoegd

 

[VenA]

obv van het voorbeeld.

Sub VenA()
With Sheets("Blad1")
    .[G2:AG8] = .[D2:AD8].Value
    .[G2:G8].Sort [G2], 2
End With
End Sub

 

[Helpzoekende]

obv van het voorbeeld.

Sub VenA()
With Sheets("Blad1")
    .[G2:AG8] = .[D2:AD8].Value
    .[G2:G8].Sort [G2], 2
End With
End Sub

Bedankt. Dit is net wat ik aan het zoeken was. U bent van harte bedankt.
Ik zal erbij zetten dat het antwoord gevonden is.

 

[VenA]

Graag gedaan. Voor een volgende keer graag het advies van snb in acht nemen en svp ook niet onnodig quoten.