Oprette nyt række basseret på kritterier VBA

Kære eksperter

Nogen som kan hjælpe mig med en VBA kode.

Jeg har kolonne A:J med data på fanen "Data"
Det jeg ønsker er at hvis kolonne H i fanen Data indholder værdi fra fanen "Dataliste" A2:A26  (antal rækker i A er dynamisk) så skal den på fanen Data lige under rækken der opfylder kriterrie oprette nyt række. I den nye række skal den kopiere data fra rækken over hvor i kolonne A tilføjes 10000 til den eksisterende værdi, kolonne B række koperes bare, hvis kolonne D i rækken indholder "buy" skal den indsætte "sell" hvis der står "sell" så skal den indsætte "buy",  og celle H skal udfyldes med DDK

Lige nu har jeg lavet en kode som gøre det hvor den kikker i kolonne J hvis det står "yes" så kører den ønskede oprettelse, problemet er bare at det er en tung kode som kører langsom eller crasher fordi antal rækker den skal kikke igennem kan være op over 30000,
koden er:

Dim yes as range
Dim Datareg As Range
Dim DataSht As Worksheet

Set Datareg = Sheets("Data")
Set Datareg = DataSht.Column(10)

Application.Screeen Updating = False
Lastrow = DataSht.Cells(Rows.Count, "B").End(xlUp).Row

For i = Lastrow To 2 Step -1

If ActiveSheet.Cells(i, "J").Value = "Yes" Then
ActiveSheet.Rows(i +1).Insert Shift:=xlUp
Cells(i+1, "A").Value = Cells(i, "A") + 10000
Cells(i+1, "B").Value = Cells(i "B")
If cells (i, "D").Value = "Buy" Then
Cells(i+1, "D").Value ="Sell"
elseif Celles(i, "D"). value = "Sell" then
cells (i +1 "D").value = "buy"
End if
Cells(i+1, "F").Value =Cells(i, "C")* Cells(i, "F")
Cells(i+1, "H").Value = "DDK"
end if
next i
LastrowB = DataSht.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 to LastrowB
If DataSht.Cells(i, "D").Value = "Sell" Then
Worksheets("Data").Cells(i, "F").Cut Cells(i, "G")
End if

Håber nogen kan hjælpe med at jeg slipper for oprette kolonne J med et yes, men i stedet der kikker direkte i listen på fanen Datalise
og håber det kan laves mere effektivt vba kode i forhold til ovenstående

på forhånd tak