VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!

[cuongbv2103]

Em chạy mà nó cứ báo lỗi subscript out of range, tên sheet, vùng lấy đều đúng.
các bác giúp em với.
em cảm ơn!

 

[hvnhpro]

Range đúng, sheet đúng, còn work book đúng ko?
Góp ý: bạn nên để lại đoạn code bị lỗi lên bài viết để mọi người xem cho

 

[cuongbv2103]

Range đúng, sheet đúng, còn work book đúng ko?
Góp ý: bạn nên để lại đoạn code bị lỗi lên bài viết để mọi người xem cho

Dạ đây anh:
Sub CopyDataFromClosedWorkbook()
Dim closedWB As Workbook
Dim openWB As Workbook
Dim sourceRange1 As Range
Dim sourceRange2 As Range
Dim destinationRange1 As Range
Dim destinationRange2 As Range

' Mở workbook đóng
On Error Resume Next
Set closedWB = Workbooks.Open("D:\Download\PHUONG_T4_2024.xlsx")
On Error GoTo 0

If closedWB Is Nothing Then
MsgBox "Không thể mở workbook đóng. Vui lòng kiểm tra lại đường dẫn và quyền truy cập.", vbExclamation
Exit Sub
End If

' Workbook đang mở
Set openWB = ThisWorkbook 'Workbook đang mở

' Xác định phạm vi dữ liệu trong workbook đóng
On Error Resume Next
Set sourceRange1 = closedWB.Sheets("Sheet3").Range("B4386")
Set sourceRange2 = closedWB.Sheets("Sheet2").Range("L4:AK386")
On Error GoTo 0

If sourceRange1 Is Nothing Or sourceRange2 Is Nothing Then
MsgBox "Không thể xác định phạm vi dữ liệu trong workbook đóng. Vui lòng kiểm tra lại tên sheet và phạm vi.", vbExclamation
closedWB.Close False ' Đóng workbook đóng
Exit Sub
End If

' Xác định vị trí cần paste trong workbook đang mở
On Error Resume Next
Set destinationRange1 = openWB.Sheets("Sheet3").Range("B7")
Set destinationRange2 = openWB.Sheets("Sheet3").Range("L7")
On Error GoTo 0

If destinationRange1 Is Nothing Or destinationRange2 Is Nothing Then
MsgBox "Không thể xác định vị trí paste trong workbook đang mở. Vui lòng kiểm tra lại tên sheet và vị trí paste.", vbExclamation
closedWB.Close False ' Đóng workbook đóng
Exit Sub
End If

' Paste dữ liệu từ workbook đóng sang workbook mở
sourceRange1.Copy destinationRange1
sourceRange2.Copy destinationRange2

' Đóng workbook đóng
closedWB.Close False ' False: Không lưu thay đổi, True: Lưu thay đổi

' Hiển thị thông báo khi sao chép hoàn thành
MsgBox "Dữ liệu đã được sao chép thành công từ workbook đóng vào workbook đang mở.", vbInformation
End Sub

 

[VetMini]

Chắc bạn chưa hề biết viết code bao giờ.
Chạy bị báo lỗi thì VBA cho biết ràng ràng ở dòng nào, phải cho người giúp biết dòng ấy chứ!

 

[cuongbv2103]

Chắc bạn chưa hề biết viết code bao giờ.
Chạy bị báo lỗi thì VBA cho biết ràng ràng ở dòng nào, phải cho người giúp biết dòng ấy chứ!

vâng bác ạ, em chưa viết VBA bao giờ, và đoạn mã trên là của ChatGPT, em đang học mò bác ạ. hic

 

[Hoàng Tuấn 868]

Em chạy mà nó cứ báo lỗi subscript out of range, tên sheet, vùng lấy đều đúng.

Theo những thông tin đưa lên đây thì căn cứ vào đâu để khẳng định tên Sheet, tên vùng đều đúng nhỉ.

 

[hvnhpro]

mình cũng từng gặp trường hợp như bạn, cũng không tìm được nguyên nhân.
Nhưng mình sửa phần sao cho 2 vùng range nguồn và đích đến bằng nhau thì code chạy được
Bạn thử sửa lại xem sao
Set destinationRange1 = openWB.Sheets("Sheet3").Range("B7389")
Set destinationRange2 = openWB.Sheets("Sheet3").Range("L7:AK389")

 

[cuongbv2103]

Theo những thông tin đưa lên đây thì căn cứ vào đâu để khẳng định tên Sheet, tên vùng đều đúng nhỉ.

mình cũng từng gặp trường hợp như bạn, cũng không tìm được nguyên nhân.
Nhưng mình sửa phần sao cho 2 vùng range nguồn và đích đến bằng nhau thì code chạy được
Bạn thử sửa lại xem sao
Set destinationRange1 = openWB.Sheets("Sheet3").Range("B7389")
Set destinationRange2 = openWB.Sheets("Sheet3").Range("L7:AK389")

ko được bác ạ, báo lỗi ko thể xác định phạm vi.

 

[Hoàng Tuấn 868]

Đứng ngoài học hỏi xem không dùng file để thử mà mấy bác này sửa code chay mà xác định được là chạy đúng hay không mới thú vị.

 

[Quang_Hải]

Em chạy mà nó cứ báo lỗi subscript out of range, tên sheet, vùng lấy đều đúng.
các bác giúp em với.
em cảm ơn!

Tặng bạn đoạn code xài chơi. Copy tất cả code về cho vào 1 module
Mình chỉ copy 1 phần, nếu code đúng thì tự chế cháo thêm chút là được

Sub Copy_DuLieu_Tu_File_Dong()
Dim Source As String, DataRange As String, SQL As String
Source = "D:\Download\PHUONG_T4_2024.xlsx"
DataRange = "[Sheet3$B4:D386]"
SQL = "Select * From " & DataRange
CopyData Source, SQL, "Sheet3", "B7"
End Sub
'Phần phía dưới này không cần hiểu làm gì cho mệt óc. Cứ copy về để y nguyên là được
Public Sub CopyData(sPath As String, SQL As String, DesSheet As String, DesRange As String)
With CreateObject("ADODB.Recordset")
    .Open (SQL), Provider & sPath & ExcelProperty
    Sheets(DesSheet).Range(DesRange).CopyFromRecordset .DataSource
End With
End Sub
Public Function ExcelProperty() As String
ExcelProperty = ";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"""
End Function
Public Function Provider() As String
Provider = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
End Function

 

[cuongbv2103]

Tặng bạn đoạn code xài chơi. Copy tất cả code về cho vào 1 module
Mình chỉ copy 1 phần, nếu code đúng thì tự chế cháo thêm chút là được

Sub Copy_DuLieu_Tu_File_Dong()
Dim Source As String, DataRange As String, SQL As String
Source = "D:\Download\PHUONG_T4_2024.xlsx"
DataRange = "[Sheet3$B4:D386]"
SQL = "Select * From " & DataRange
CopyData Source, SQL, "Sheet3", "B7"
End Sub
'Phần phía dưới này không cần hiểu làm gì cho mệt óc. Cứ copy về để y nguyên là được
Public Sub CopyData(sPath As String, SQL As String, DesSheet As String, DesRange As String)
With CreateObject("ADODB.Recordset")
    .Open (SQL), Provider & sPath & ExcelProperty
    Sheets(DesSheet).Range(DesRange).CopyFromRecordset .DataSource
End With
End Sub
Public Function ExcelProperty() As String
ExcelProperty = ";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"""
End Function
Public Function Provider() As String
Provider = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
End Function

vâng bác, để em thử xem sao.

 

[VetMini]

Tặng bạn đoạn code xài chơi. Copy tất cả code về cho vào 1 module
Mình chỉ copy 1 phần, nếu code đúng thì tự chế cháo thêm chút là được

...
Public Function ExcelProperty() As String
ExcelProperty = ";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"""
End Function
Public Function Provider() As String
Provider = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
End Function

2 cái functions này luôn luôn trả về hằng, không nhận tham số, ngay cả thông số evironment nó cũng chả xét.
Như vậy thì chúng là hằng quách rồi. Đặt function chi cho lúc gọi thêm tốn củi lửa.

Chú thích: lúc đặt tên function nên tránh các tên quá rõ rệt. Dễ bị đụng chạm với các tên có sẵn trong VBA.

 

[Quang_Hải]

2 cái functions này luôn luôn trả về hằng, không nhận tham số, ngay cả thông số evironment nó cũng chả xét.
Như vậy thì chúng là hằng quách rồi. Đặt function chi cho lúc gọi thêm tốn củi lửa.

Chú thích: lúc đặt tên function nên tránh các tên quá rõ rệt. Dễ bị đụng chạm với các tên có sẵn trong VBA.

Nào giờ em lại không chú ý vụ này, cứ copy qua lại mà xài, dù không tốn bao nhiêu điện nước nhưng mà nhìn kỹ thì đúng là kỳ cục.