Satır kopyalayacak makro yardımı

[bedri41]

Ekte küçük bir kısmını gönderdiğim dosyamın içerisinde Z sütununda DENEME yazan yerin yanına OK yazdığımda aynı satırdan günün tarihi ile en alta bir satır oluşturmasını istiyorum. Dosya şu an 40000 satırın üzerinde ve bu işi kopyala yapıştır ile yapmak dosya içerisinde aşağı yukarı dolaşmak oldukça zaman alıyor.

 

[İhsan Tank]

Ekte küçük bir kısmını gönderdiğim dosyamın içerisinde Z sütununda DENEME yazan yerin yanına OK yazdığımda aynı satırdan günün tarihi ile en alta bir satır oluşturmasını istiyorum. Dosya şu an 40000 satırın üzerinde ve bu işi kopyala yapıştır ile yapmak dosya içerisinde aşağı yukarı dolaşmak oldukça zaman alıyor.

Merhaba
Sayfa1'in kod bölümüne

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Z:AA")) Is Nothing Then Exit Sub
Dim ts, kaplan, trabzonspor
If Cells(Target.Row, "Z") = "DENEME" And Cells(Target.Row, "AA") = "OK" Then
trabzonspor = Range("A1048576").End(xlUp).Row
Range("B" & trabzonspor + 1) = Cells(Target.Row, "B")
Range("C" & trabzonspor + 1) = Cells(Target.Row, "C")
Range("D" & trabzonspor + 1) = Cells(Target.Row, "D")
Range("E" & trabzonspor + 1) = Cells(Target.Row, "E")
Range("F" & trabzonspor + 1) = Cells(Target.Row, "F")
Range("G" & trabzonspor + 1) = Cells(Target.Row, "G")
Range("H" & trabzonspor + 1) = Cells(Target.Row, "H")
Range("I" & trabzonspor + 1) = Cells(Target.Row, "I")
Range("J" & trabzonspor + 1) = Cells(Target.Row, "J")
Range("K" & trabzonspor + 1) = Cells(Target.Row, "K")
Range("L" & trabzonspor + 1) = Cells(Target.Row, "L")
Range("M" & trabzonspor + 1) = Cells(Target.Row, "M")
Range("N" & trabzonspor + 1) = Cells(Target.Row, "N")
Range("O" & trabzonspor + 1) = Cells(Target.Row, "O")
Range("P" & trabzonspor + 1) = Cells(Target.Row, "P")
Range("Q" & trabzonspor + 1) = Cells(Target.Row, "Q")
Range("R" & trabzonspor + 1) = Cells(Target.Row, "R")
Range("S" & trabzonspor + 1) = Cells(Target.Row, "S")
Range("T" & trabzonspor + 1) = Cells(Target.Row, "T")
Range("U" & trabzonspor + 1) = Cells(Target.Row, "U")
Range("V" & trabzonspor + 1) = Cells(Target.Row, "V")
Range("W" & trabzonspor + 1) = Cells(Target.Row, "W")
Range("X" & trabzonspor + 1) = Cells(Target.Row, "X")
Range("Y" & trabzonspor + 1) = Cells(Target.Row, "Y")
Range("A" & trabzonspor + 1) = Date
End If
End Sub

Kopyalayın ve deneyin

 

[bedri41]

Teşekkür ederim elinize sağlık

 

[İhsan Tank]

Teşekkür ederim elinize sağlık

Rica ederim
:yazici: