Ðề: Sao chép dữ liệu từ file đến file
Gửi bởi
van80
Hỏi: Cần giúp trong Vba, với yêu cầu như sau:
Yêu cầu mình có mô tả chi tiết trong file đính kèm, mình xin trích dẫn 1 ý như sau:
- Tại ô D4 = 1 và ta click vào nút lệnh tong hop 18k thì chương trình sẽ mở ra hộp thoại Open.
- Ta dựa vào hộp thoại Open này tìm đến file k1.
- Khi đó dữ liệu trong file k1 của sheet(k1) sao chép vào sheet(data) của file tonghop.
Kết thúc !
- Tương tự như vậy cho những k còn lại
- Nhiệm vụ của sheet(data) phải chứa dữ liệu của 18k
Chú ý ô D4 là ô điều kiện cần sao chép dữ liệu.
Mong các Anh, chị trên diễn đàn giúp dùm, trân trọng cảm ơn !
file đính kèm là :
View attachment 13712
Nếu muốn làm như chủ thớt thì đây là đoạn code
Mã nguồn PHP:
[COLOR=#000000]
Sub CopyData[/COLOR][COLOR=#007700]()
[/COLOR][COLOR=#0000BB]Dim MyPath [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String
Dim fName [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String
Dim n [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Long[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]k [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Long
Dim Wb [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Workbook
Dim Ws [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Worksheet
Dim TenSh [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String
Application[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]ScreenUpdating [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]False
On Error Resume Next
MyPath [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]ThisWorkbook[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Path
fName [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"k" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Sheet2[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#DD0000]"D4"[/COLOR][COLOR=#007700]) & [/COLOR][COLOR=#DD0000]".xls"
[/COLOR][COLOR=#0000BB]TenSh [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"k" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Sheet2[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#DD0000]"D4"[/COLOR][COLOR=#007700])
[/COLOR][COLOR=#0000BB]Set Wb [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]Workbooks[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Open[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]MyPath [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]"\" & fName)
Set Ws = Wb.Worksheets(TenSh)
k = Ws.Range("[/COLOR][COLOR=#0000BB]B65000[/COLOR][COLOR=#DD0000]").End(xlUp).Row
n = Sheet1.Range("[/COLOR][COLOR=#0000BB]B65000[/COLOR][COLOR=#DD0000]").End(xlUp).Row
If k > 7 Then Ws.Range("[/COLOR][COLOR=#0000BB]A8[/COLOR][COLOR=#007700]:[/COLOR][COLOR=#0000BB]W[/COLOR][COLOR=#DD0000]" & k).Copy Destination:=Sheet1.Range("[/COLOR][COLOR=#0000BB]A[/COLOR][COLOR=#DD0000]" & n + 1)
Wb.Save
Wb.Close
Application.ScreenUpdating = True
MsgBox "[/COLOR][COLOR=#0000BB]Xong[/COLOR][COLOR=#DD0000]", , "[/COLOR][COLOR=#0000BB]Thong Bao[/COLOR][COLOR=#DD0000]"
Sheet1.Select
End Sub[/COLOR]
Lưu ý : Sheet data luôn dược cập nhật tiếp từ dòng cuối cùng trở xuống. Nếu làm theo ý tưởng của tôi ở bài trên thì cứ mỗi lần cập nhật nó sẽ xóa dữ liệu cũ và cập nhật số liệu mới
Thân mến
Sự ra đời của các thiết bị công nghệ – khoa học tiền tiến đã tạo tiền đề thúc đẩy nền kinh tế, từng lớp phát triển hơn. Những thiết bị, ứng dụng này tương trợ con người giải quyết công việc mau...
Bàn luận nhiều tác động tích cực của công nghệ thông tin cho con người