Giúp sửa code copy (1 người xem)

[minhtuan55]

Chào cả nhà GPE !
Em có vấn đề này cần các anh giúp em. Em có dùng đoạn Code trên để copy từ vùng A2:A10 để lưu sao sheet data.

Sub copy()
Application.ScreenUpdating = False
Range("A2:A10").copy
Sheets("data").Range("A50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
MsgBox ("Da save")
Application.ScreenUpdating = True
End Sub

Cho em hỏi vấn đển sau:
1. có cách nào viết ngắn hơn code trên không?
2. Có cách nào viết code tối ưu hơn, nhanh hơn mà không dùng lệnh copy. Vì nó làm tăng dung lượng bộ nhớ ram ( vì file đây là file mẫu chứ file thực tế của mình từ A2:A100 )
Em xin cảm ơn!

 

[HieuCD]

Chào cả nhà GPE !
Em có vấn đề này cần các anh giúp em. Em có dùng đoạn Code trên để copy từ vùng A2:A10 để lưu sao sheet data.

Sub copy()
Application.ScreenUpdating = False
Range("A2:A10").copy
Sheets("data").Range("A50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
MsgBox ("Da save")
Application.ScreenUpdating = True
End Sub

Cho em hỏi vấn đển sau:
1. có cách nào viết ngắn hơn code trên không?
2. Có cách nào viết code tối ưu hơn, nhanh hơn mà không dùng lệnh copy. Vì nó làm tăng dung lượng bộ nhớ ram ( vì file đây là file mẫu chứ file thực tế của mình từ A2:A100 )
Em xin cảm ơn!

bạn dùng thử code, tối ưu hơn hay chậm hơn thì mình cũng chưa thử

Sub copy()
Dim Arr()
Arr = Sheets("Sheet1").Range("A2:A10").Value
Sheets("data").Range("A50000").End(xlUp).Offset(1).Resize(, 9) = WorksheetFunction.Transpose(Arr)
Erase Arr
MsgBox ("Da save")
End Sub

 

[minhtuan55]

bạn dùng thử code, tối ưu hơn hay chậm hơn thì mình cũng chưa thử

Sub copy()
Dim Arr()
Arr = Sheets("Sheet1").Range("A2:A10").Value
Sheets("data").Range("A50000").End(xlUp).Offset(1).Resize(, 9) = WorksheetFunction.Transpose(Arr)
Erase Arr
MsgBox ("Da save")
End Sub

Code của anh khá là nhẹ. để em test 1 thời gian thư xem. Anh cho em hỏi Erase Arr Dùng để làm gì

 

[HieuCD]

Code của anh khá là nhẹ. để em test 1 thời gian thư xem. Anh cho em hỏi Erase Arr Dùng để làm gì

Erase Arr xóa bộ nhớ của biến Arr, nhằm giải phóng bộ nhớ

 

[minhtuan55]

bạn dùng thử code, tối ưu hơn hay chậm hơn thì mình cũng chưa thử

Sub copy()
Dim Arr()
Arr = Sheets("Sheet1").Range("A2:A10").Value
Sheets("data").Range("A50000").End(xlUp).Offset(1).Resize(, 9) = WorksheetFunction.Transpose(Arr)
Erase Arr
MsgBox ("Da save")
End Sub

Anh ơi ví dụ em muốn bỏ cái Transpose thì e sửa code lại làm sao
và nhiều khi e muốn copy sang 1 vùng cố định, e không muốn End(xlUp).Offset(1).Resize(, 9)

 

[HieuCD]

Anh ơi ví dụ em muốn bỏ cái Transpose thì e sửa code lại làm sao
và nhiều khi e muốn copy sang 1 vùng cố định, e không muốn End(xlUp).Offset(1).Resize(, 9)

hơi dài một chút nhưng cũng khá nhanh

Sub copy()
Dim Darr(), Arr(), i as long
Darr = Sheets("Sheet1").Range("A2:A10").Value
Redim Arr(1 to 1, 1 to Ubound(Darr))
For i=1 to Ubound(Darr)
Arr(1,i) = Darr(i,1)
Next i
Sheets("data").Range([COLOR=#ff0000]"A10"[/COLOR]).Resize(, 9) =Arr
Erase Arr: Erase Darr
MsgBox ("Da save")
End Sub