Giúp tăng tốc code copy từ excel sang excel

[phamkhacni]

Chào các bác, hiện tại em đang dùng code của 1 bác trên 4rum
Nhưng có copy hơi chậm, bác nào có code copy 1 sheet từ file này file khác nhanh hơn thì cho em xin với ạ
Chỉ copy giá trị, k copy định dạng thì càng tốt ạ

Sub Button1_Click()With Application.FileDialog(1)
        .InitialFileName = ThisWorkbook.Path
        .Title = "Chon file nguon"
        .FilterIndex = 3
        .AllowMultiSelect = False
        Do
            .Show
            If .SelectedItems.Count = 0 Then Exit Sub
            If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"
        Loop Until .SelectedItems(1) <> ThisWorkbook.FullName
        With Workbooks.Open(.SelectedItems(1))
            .Sheets(1).Cells.Copy ThisWorkbook.Sheets(1).[A1]
            .Close False
    End With
End Sub

 

[ndu96081631]

Chào các bác, hiện tại em đang dùng code của 1 bác trên 4rum
Nhưng có copy hơi chậm, bác nào có code copy 1 sheet từ file này file khác nhanh hơn thì cho em xin với ạ
Chỉ copy giá trị, k copy định dạng thì càng tốt ạ

Dùng ADO nhé ---> Tìm trên diễn đàn, có cả đống

 

[nmhung49]

Chào các bác, hiện tại em đang dùng code của 1 bác trên 4rum
Nhưng có copy hơi chậm, bác nào có code copy 1 sheet từ file này file khác nhanh hơn thì cho em xin với ạ
Chỉ copy giá trị, k copy định dạng thì càng tốt ạ

Bạn có thể gán vào mảng tạm rồi trả lại sheet muốn copy sẽ có thể nhanh hơn vì code copy nguyên sheet nên chậm nên dùng usedrange để giới hạn vùng copy cho nhanh
Ví dụ này chẳng hạn, còn không thì dung ADO nhưng anh NDU nói mà copy hết cells như bạn code cũng chậm bình thường

Sub test1()
Dim tmparr
tmparr = Sheet1.UsedRange.Value
Sheet2.Range("A1").Resize(UBound(tmparr, 1), UBound(tmparr, 2)) = tmparr
End Sub

 

[phamkhacni]

Bạn có thể gán vào mảng tạm rồi trả lại sheet muốn copy sẽ có thể nhanh hơn vì code copy nguyên sheet nên chậm nên dùng usedrange để giới hạn vùng copy cho nhanh
Ví dụ này chẳng hạn, còn không thì dung ADO nhưng anh NDU nói mà copy hết cells như bạn code cũng chậm bình thường

Sub test1()
Dim tmparr
tmparr = Sheet1.UsedRange.Value
Sheet2.Range("A1").Resize(UBound(tmparr, 1), UBound(tmparr, 2)) = tmparr
End Sub

Em k rành code bác ạ.
Nếu được bác sửa code trên cho nó chỉ copy vùng có dữ liệu dùm em được k?