Giúp mình tạo module copy từ file này sang file khác có lựa chọn file và sheet (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

phieulang31

Thành viên mới
Tham gia
17/5/12
Bài viết
34
Được thích
3
Mình đang nhập điểm trong chương trình Emis, phải copy từng sheet của từng lớp, mà nhiều lớp quá, copy lâu lắm..
- Mình có file như thế này
Tao module copy.jpg
Mình muốn nhờ các pro tạo module copy như sau:
- Mình chọn lớp 6A, môn học: Toán trong file "Tao module copy". Khi nhấn nút "Copy dữ liệu" thì module sẽ tự copy từ file: 6a.xls, sheet: Toán sang sheet : Toán của file Tong hop lop 6A.xls. Tương tự như các lớp khác..
Mình không rành VB, mày mò cả tuần nay rồi mà không viết được.(viết hàm thì được)!
File demo ở dưới nhé!
Mong các bạn giúp mình! Không thì đau đầu chết mất !$@!!
 

File đính kèm

Mình đang nhập điểm trong chương trình Emis, phải copy từng sheet của từng lớp, mà nhiều lớp quá, copy lâu lắm..
- Mình có file như thế này
View attachment 95931
Mình muốn nhờ các pro tạo module copy như sau:
- Mình chọn lớp 6A, môn học: Toán trong file "Tao module copy". Khi nhấn nút "Copy dữ liệu" thì module sẽ tự copy từ file: 6a.xls, sheet: Toán sang sheet : Toán của file Tong hop lop 6A.xls. Tương tự như các lớp khác..
Mình không rành VB, mày mò cả tuần nay rồi mà không viết được.(viết hàm thì được)!
File demo ở dưới nhé!
Mong các bạn giúp mình! Không thì đau đầu chết mất !$@!!

phần tô màu đỏ đó nằm ở đâu?
nếu nó nằm trên file "Tao module copy" (ví dụ mình đổi sheet2 của file này thành Toan đi), thì copy xong sheet toán ở lớp 6a xong rồi copy sheet toan ở lớp 6b, thì nối tiếp vào phải ko?

sorry, thấy rùi. đang thử làm cho bạn.pls wait


sorry một lần nữa, yêu cầu của bạn thật lạ lùng, sheet toán trong file 6a và file tổng hôp 6A, y chang nhau, chi khác có một cột giới tính (nam/nữ). vậy dùng macro chi cho cực dữ vậy?
 
Lần chỉnh sửa cuối:
Upvote 0
sorry một lần nữa, yêu cầu của bạn thật lạ lùng, sheet toán trong file 6a và file tổng hôp 6A, y chang nhau, chi khác có một cột giới tính (nam/nữ). vậy dùng macro chi cho cực dữ vậy?

Đúng vậy! Có hơi rắc rối..
Nhưng mỗi lần mình nhập điểm : 13 môn x 25 lớp = 325 lần copy (@ đầu, dễ nhầm lớp với môn lắm)! Mà làm sai điểm của 1 môn là sai tổng kết TBCM của các em..
 
Upvote 0
ở sheet toán của file tổng hợp, bạn còn có chép data ờ file nào vào đây ko?
nếu ko, sau khi bạn nhập điểm xong ở file 6a (hoặc 6b) thì save as thành tonghop6A. rồi trong mỗi sheet chỉ việc delete cáo cột nam/nữ đi là xong.
việc tạo ra một macro, mở file, copy, dán vào đâu đó thì ko khó nhưng file tổng hợp thì nó phải tổng hợp từ nhiều file lại (thí dụ nó chứa lớp 6a,6b,6c..v.v.), đằng này nó chỉ chứa có một file thì việc tạo ra cái macro đó là ko cần thiếc
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Chắc tại câu hỏi chưa rõ nên mình hỏi lại nhé.. }}}}}

Mình có nhiều file, mỗi file có thể có một hoặc nhiều môn, mỗi môn 1 sheet.

Mình muốn chép những file riêng lẻ này vào file tổng hợp của mỗi lớp.

Ví dụ: Trong file " Tao module copy" mình chọn lớp 6A, môn Toán và nhấn "nút copy dữ liệu"

thì module sẽ giúp mình: copy điểm trong sheet "Toán" của file "Toan 6A" vào phần điểm của sheet "Toán" của file

"Tong hop diem KI 6A";

Mình muốn copy tiếp môn Lý của lớp 6A thì mình chỉ việc chọn lại môn "Lý" trong file " Tao module copy" thôi.

Tương tự mình có thể copy nhiều lớp, nhiều môn mà chỉ việc chọn lớp và môn trong file "Tao Module copy" !$@!!

Việc chọn môn và lớp mình đã tạo list rồi!

Bạn tải file lại nhé!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Không thấy pro nào ra tay ( trừ bạn nhapmon) vậy!?!

Không lẽ khó vậy sao? Hay là không làm được trong Excel?

Các bạn cho ý kiến nhé!! Mình suy nghĩ @ cái đầu rùi...

 
Upvote 0
bạn đã tải thử bài ở #4 chưa? vẫn ko đúng ý bạn hả? (nhớ khai báo lại đường dẫn).
vẫn ko được nữa thì đành đợi cao thủ vậy.

chúc bạn mai nắm lần sau.....hì hì
 
Upvote 0
Không thấy pro nào ra tay ( trừ bạn nhapmon) vậy!?!

Không lẽ khó vậy sao? Hay là không làm được trong Excel?

Các bạn cho ý kiến nhé!! Mình suy nghĩ @ cái đầu rùi...

Bài này không khó, tuy nhiên chưa rảnh nên chưa mần. Đợi vài ngày nếu chưa ai mần thì mình mần cho.
 
Lần chỉnh sửa cuối:
Upvote 0
Cao nhân có khác, nhưng sao phải đợi " không ai mần thì mới mần" ?
Bạn làm mình phải đợi dài cổ nữa rùi! !$@!!
Bạn xem file xem thế nào rồi tính tiếp. Lưu ý là tên các file phải tạo đúng nhé. Chẳng hạn trong list của bạn là Vat li nhưng tên file là 6A Ly thì code nó tèo thôi. Tên file Tong hop bạn đặt tên cũng không chuẩn, lòi theo 1 khoảng trắng thừa thì cũng sẽ gây lỗi. Tóm lại mình không thích bẫy lỗi cho nên bạn phải chịu khó chuẩn hóa thông tin, nếu không lỗi ráng chịu.
Mình không có phải "cao" nhân đâu, cao có 1.65 thôi.
Code cũng đơn giản thôi, chỉ sợ là chưa hiểu hết ý của bạn thôi
PHP:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh
Dim HK, Lop, Mon
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         sh.UsedRange.Copy TH.Sheets(sh.Name).[A1]
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub
 

File đính kèm

Upvote 0
Cảm ơn Quang Hải nhiều nhé! Mình làm được rồi.. Tuyệt vời..}}}}}

Nhưng còn vấn đề nhỏ nữa thôi! Cái này tại mình nêu yêu cầu chưa rõ..

Đó là mình chỉ muốn copy phần điểm thôi! Không phải copy cả sheet..

Nếu Hải và các Pro có rảnh ( hoặc không rảnh) thì cũng giúp luôn nhé...
 
Upvote 0
Cảm ơn Quang Hải nhiều nhé! Mình làm được rồi.. Tuyệt vời..}}}}}

Nhưng còn vấn đề nhỏ nữa thôi! Cái này tại mình nêu yêu cầu chưa rõ..

Đó là mình chỉ muốn copy phần điểm thôi! Không phải copy cả sheet..

Nếu Hải và các Pro có rảnh ( hoặc không rảnh) thì cũng giúp luôn nhé...
Cái sườn có rồi, muốn chỉnh sửa theo ý thì ráng xử đi. Nếu sau vài tháng chưa xử nổi thì mình xem cho. Chẳng có gì là khó cả. Khó quá bỏ.
 
Upvote 0
Cái sườn có rồi, muốn chỉnh sửa theo ý thì ráng xử đi. Nếu sau vài tháng chưa xử nổi thì mình xem cho. Chẳng có gì là khó cả. Khó quá bỏ.

Sao nặng lời thế! Để làm thử xem sao!? Xong sẽ đưa lên xin ý kiến...

Đang nghiên cứu tài liệu, chắc cũng mất vài tháng như Hải nói quá...
Mà cũng nói trước, khó quá .. bỏ!--=0
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn xem file xem thế nào rồi tính tiếp. Lưu ý là tên các file phải tạo đúng nhé. Chẳng hạn trong list của bạn là Vat li nhưng tên file là 6A Ly thì code nó tèo thôi. Tên file Tong hop bạn đặt tên cũng không chuẩn, lòi theo 1 khoảng trắng thừa thì cũng sẽ gây lỗi. Tóm lại mình không thích bẫy lỗi cho nên bạn phải chịu khó chuẩn hóa thông tin, nếu không lỗi ráng chịu.
Mình không có phải "cao" nhân đâu, cao có 1.65 thôi.
Code cũng đơn giản thôi, chỉ sợ là chưa hiểu hết ý của bạn thôi
PHP:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh
Dim HK, Lop, Mon
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         sh.UsedRange.Copy TH.Sheets(sh.Name).[A1]
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub

Bạn nào giỏi về VB giúp anh em giải thích từng dòng trong "Module" của bạn Hải không?

Mình có đọc tài liệu rồi nhưng chưa hiểu hết... Thank trước!!
 
Upvote 0
Bạn nào giỏi về VB giúp anh em giải thích từng dòng trong "Module" của bạn Hải không?

Mình có đọc tài liệu rồi nhưng chưa hiểu hết... Thank trước!!

Chưa hiểu hết vậy đã hiểu dòng nào rồi? Dòng nào chưa hiểu thì mình sẽ giải thích dòng đó giúp cho
 
Upvote 0
Chưa hiểu hết vậy đã hiểu dòng nào rồi? Dòng nào chưa hiểu thì mình sẽ giải thích dòng đó giúp cho

Hai dòng này: Mình tạm hiểu theo tiếng Anh:

If sh.UsedRange.Count > 0 Then (Nếu vùng sử dụng dương thì)

sh.UsedRange.Copy TH.Sheets(sh.Name).[A1]

thực hiện copy vào ô A1 của TH ( Nếu không đúng các bạn chỉ dùm)

Mình không hiểu bạn chọn vùng copy ở đâu? Nếu mình không copy cả sheet mà chỉ chọn 1 vùng nào đó thôi thì làm thế nào?

Với trong phần khai báo biến: FileToOpen As Workbook, sh

Trong đó, sh là gì vậy bạn? +-+-+-+

Các bạn đừng cười nhé! (cố gắng lắm rồi!!):=\+
 
Lần chỉnh sửa cuối:
Upvote 0
Hai dòng này: Mình tạm hiểu theo tiếng Anh:

If sh.UsedRange.Count > 0 Then (Nếu vùng sử dụng dương thì

sh.UsedRange.Copy TH.Sheets(sh.Name).[A1]

thực hiện copy vào ô A1 của TH ( Nếu không đúng các bạn chỉ dùm)

Mình không hiểu bạn chọn vùng copy ở đâu? Nếu mình không copy cả sheet mà chỉ chọn 1 vùng nào đó thôi thì làm thế nào?

Với trong phần khai báo biến: FileToOpen As Workbook, sh

Trong đó, sh là gì vậy bạn? +-+-+-+

Các bạn đừng cười nhé! (cố gắng lắm rồi!!):=\+

sh là biến để sử dụng trong code, nói chung cũng không biết nói sao
Bạn có thể thử thế này
sh.[F6:AG44].Copy TH.Sheets(sh.Name).[F6]
 
Lần chỉnh sửa cuối:
Upvote 0
Thành công rồi! Dễ thế mà ... toát mồ hôi mấy ngày...

Tiện thể anh Hải xem tài liệu học VB cho excel này có chuẩn không!? Không thì lại tốn thời gian mà kết quả @ @.. nữa..

Link tài liệu: Giao trinh TDHTKCD - Tong hop
 
Lần chỉnh sửa cuối:
Upvote 0
Thành công rồi! Dễ thế mà ... toát mồ hôi mấy ngày...

Tiện thể anh Hải xem tài liệu học VB cho excel này có chuẩn không!? Không thì lại tốn thời gian mà kết quả @ @.. nữa..

Link tài liệu: Giao trinh TDHTKCD - Tong hop
Tài liệu nào cũng có cái hay riêng của nó. Cày nhiều sẽ mau tiến bộ.
Tài liệu gần gủi nhất là vào cửa sổ VBE, đọc hết Help trong đó là gọn nhất. Có đầy đủ cú pháp và code mẫu. Phối hợp với kiến thức trên GPE thì không chê chỗ nào được. Mình chỉ mới bập bẹ thôi, vì mới đọc được có vài trang.
 
Lần chỉnh sửa cuối:
Upvote 0
Tài liệu nào cũng có cái hay riêng của nó. Cày nhiều sẽ mau tiến bộ.
Tài liệu gần gủi nhất là vào cửa sổ VBE, đọc hết Help trong đó là gọn nhất. Có đầy đủ cú pháp và code mẫu. Phối hợp với kiến thức trên GPE thì không chê chỗ nào được. Mình chỉ mới bập bẹ thôi, vì mới đọc được có vài trang.

Em sẽ nghiên cứu! Tính cảm ơn nữa sợ anh em ganh tị...--=0.. nhưng vẫn cảm ơn! Văn hóa người Việt mà!!
 
Upvote 0
sh là biến để sử dụng trong code, nói chung cũng không biết nói sao
Bạn có thể thử thế này
sh.[F6:AG44].Copy TH.Sheets(sh.Name).[F6]

Pro Hải nhiệt tình quá!
Mình thấy code của bạn rất hay nhưng hình như chủ topic còn quên vấn đề : là phải dò danh sách lại trước khi copy phần điểm chứ! Vì hình như Phieulang31 chỉ muốn copy phần điểm thôi mà!
Phải chi bạn viết như thế này: Dò danh sách trước, nếu đúng thì thực hiện copy.. thì hay quá.
Cái này thì chịu, không viết được!!
 
Upvote 0
Pro Hải nhiệt tình quá!
Mình thấy code của bạn rất hay nhưng hình như chủ topic còn quên vấn đề : là phải dò danh sách lại trước khi copy phần điểm chứ! Vì hình như Phieulang31 chỉ muốn copy phần điểm thôi mà!
Phải chi bạn viết như thế này: Dò danh sách trước, nếu đúng thì thực hiện copy.. thì hay quá.
Cái này thì chịu, không viết được!!

Hôm trước a Hải làm dùm mình! Mình cũng phát hiện ra cái này, thử thêm code vào nhưng bị báo lỗi hoài ah!

Mình thêm như thế này(dòng màu đỏ), bị báo lỗi "Sub" và dòng 13
Mã:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh
Dim HK, Lop, Mon
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If [COLOR=#ff0000]sh.[A[/COLOR][COLOR=#FF0000]6:B55] = TH.Sheets(sh.Name).[A6:B55][/COLOR] Then                         [COLOR=#0000ff]'Bị báo lỗi[/COLOR]
         sh.[F6:AG44].Copy TH.Sheets(sh.Name).[F6]
         Else
         MsgBox "Do lai danh sach"
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub

Không nghĩ ra! Bạn nào biết chỉ giáo..
 
Upvote 0
If sh.[A6:B55] = TH.Sheets(sh.Name).[A6:B55] Then 'Bị báo lỗi

..

bạn không thể đem một vùng này so sánh với vùng kia được.
ý của hai bạn "dò" là sao? bạn cho biết điều kiện "dò" mình làm thử coi được ko.

ah, hai bạn định dò danh sách có giống nhau ko phải ko?
sao ko copy qua luôn đi cho chắc ăn, khỏi fai dò.
muốn dò thì phải dùng vòng lặp for...next
chẳng hạn như
..............................
With FileToOpen
For Each sh In .Worksheets
for i=6 to sh.[b5000].end(xlup).row
if sh.range("B" & i).value <>TH.sheets(sh.name).range("B" & i).value
msgbox "Danh Sach Ko Trung"
exit sub
end if
next i
sh.[f6:ag44].copy TH.sheets(sh.name).[f6]
next
.........................
 
Lần chỉnh sửa cuối:
Upvote 0
Hôm trước a Hải làm dùm mình! Mình cũng phát hiện ra cái này, thử thêm code vào nhưng bị báo lỗi hoài ah!

Mình thêm như thế này(dòng màu đỏ), bị báo lỗi "Sub" và dòng 13
Mã:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh
Dim HK, Lop, Mon
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If [COLOR=#ff0000]sh.[A[/COLOR][COLOR=#FF0000]6:B55] = TH.Sheets(sh.Name).[A6:B55][/COLOR] Then                         [COLOR=#0000ff]'Bị báo lỗi[/COLOR]
         sh.[F6:AG44].Copy TH.Sheets(sh.Name).[F6]
         Else
         MsgBox "Do lai danh sach"
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub

Không nghĩ ra! Bạn nào biết chỉ giáo..

Vấn đề nằm ở chỗ bạn không mô tả rõ ràng thì chẳng biết đâu mà giúp.
Muốn sửa code phải hiểu tác dụng của từng dòng code chứ nếu sửa mò mẫm thì chắc chắn là sai thôi
 
Upvote 0
bạn không thể đem một vùng này so sánh với vùng kia được.
ý của hai bạn "dò" là sao? bạn cho biết điều kiện "dò" mình làm thử coi được ko.

ah, hai bạn định dò danh sách có giống nhau ko phải ko?
sao ko copy qua luôn đi cho chắc ăn, khỏi fai dò.
muốn dò thì phải dùng vòng lặp for...next
chẳng hạn như
..............................
With FileToOpen
For Each sh In .Worksheets
for i=6 to sh.[b5000].end(xlup).row
if sh.range("B" & i).value <>TH.sheets(sh.name).range("B" & i).value
msgbox "Danh Sach Ko Trung"
exit sub
end if
next i
sh.[f6:ag44].copy TH.sheets(sh.name).[f6]
next
.........................

Tại mình xuất từng file, mỗi file là một môn/lớp và giao cho người khác nhập điểm!

Mình sợ danh sách trong các file bị sửa lại hoặc mình xuất file sai danh sách..

Nên cần phải dò lại lại danh sách trước khi copy..

Cái này có thể dùng hàm nhưng mình nghĩ module có thể kiểm tra danh sách nên làm, mà làm hoài không được! +-+-+-+
 
Upvote 0
Vấn đề nằm ở chỗ bạn không mô tả rõ ràng thì chẳng biết đâu mà giúp.
Muốn sửa code phải hiểu tác dụng của từng dòng code chứ nếu sửa mò mẫm thì chắc chắn là sai thôi

Mình nghĩ không chỉ hiểu từng dòng thôi mà còn phải hiểu logic giữa các dòng nữa ...
 
Upvote 0
..............................
With FileToOpen
For Each sh In .Worksheets
for i=6 to sh.[b5000].end(xlup).row
if sh.range("B" & i).value <>TH.sheets(sh.name).range("B" & i).value
msgbox "Danh Sach Ko Trung"
exit sub
end if
next i
sh.[f6:ag44].copy TH.sheets(sh.name).[f6]
next
.........................

Bị báo lỗi như thế này, bó tay rui!! +-+-+-+

Các bạn xem tại đây nhé! ( Không bit post ảnh ở đây)
 
Upvote 0
Bị báo lỗi như thế này, bó tay rui!! +-+-+-+

Các bạn xem tại đây nhé! ( Không bit post ảnh ở đây)
Có lẽ vấn đề là ở chỗ <>TH, ở giữa dấu > và chữ T bạn gõ thiếu 1 khoảng trắng ở giữa đó nên anh chàng VBA không chịu.

Thêm nữa, bạn nên khai báo biến tường minh thì tốt hơn, cụ thể, biến sh, bạn nên khai báo là sh As WorkSheet. Việc này sẽ có lợi cho bạn khi bạn không nhớ các phương thức, sự kiện, thuộc tính liên quan đến biến sh, lúc này bạn chỉ cần gõ dấu chấm là bạn sẽ có 1 danh sách liên quan đến sh.
 
Upvote 0
Có lẽ vấn đề là ở chỗ <>TH, ở giữa dấu > và chữ T bạn gõ thiếu 1 khoảng trắng ở giữa đó nên anh chàng VBA không chịu.

Thêm nữa, bạn nên khai báo biến tường minh thì tốt hơn, cụ thể, biến sh, bạn nên khai báo là sh As WorkSheet. Việc này sẽ có lợi cho bạn khi bạn không nhớ các phương thức, sự kiện, thuộc tính liên quan đến biến sh, lúc này bạn chỉ cần gõ dấu chấm là bạn sẽ có 1 danh sách liên quan đến sh.

Mình làm theo như hướng dẫn rồi nhưng thấy vẫn báo lỗi!!

Bạn có thể làm giúp luôn được không? Mình thấy rối rắm quá trời!!

Mã:
[COLOR=#ffff00]Sub copy_lop()[/COLOR]
Dim TH As Workbook, FileToOpen As Workbook, sh As Worksheet
Dim HK, Lop, Mon, i
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
For Each sh In .Worksheets
For i = 6 To sh.[b5000].End(xlUp).Row
[COLOR=#ff0000]if sh.range("B" & i).value <> TH.sheets(sh.name).range("B" & i).value  'Bị báo lỗi[/COLOR]
MsgBox "Danh Sach Ko Trung"
Exit Sub
End If
Next i
sh.[f6:ag44].Copy TH.Sheets(sh.Name).[f6]
Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
if sh.range("B" & i).value <> TH.sheets(sh.name).range("B" & i).value then 'Bị báo lỗi

ìf thì phải có then hoặc goto.
 
Upvote 0
Mình làm theo như hướng dẫn rồi nhưng thấy vẫn báo lỗi!!

Bạn có thể làm giúp luôn được không? Mình thấy rối rắm quá trời!!
Mình dựa vào cột D lấy mã số HS làm chuẩn để cập nhật dữ liệu. Hy vọng giúp được bạn.
Nếu không có học cơ bản thì muốn edit code thuộc dạng sơ đẳng của mình cũng không phải dễ nuốt đâu.

PHP:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh As Worksheet, Res(), Data()
Dim HK, Lop, Mon, i As Long, j As Long, x As Byte
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
         With TH.Sheets(sh.Name)
            Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(Res)
               For j = 1 To UBound(Data)
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                  End If
               Next
            Next
            .[D6].Resize(i - 1, 30) = Res
         End With
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub
 
Upvote 0
Mình dựa vào cột D lấy mã số HS làm chuẩn để cập nhật dữ liệu. Hy vọng giúp được bạn.
Nếu không có học cơ bản thì muốn edit code thuộc dạng sơ đẳng của mình cũng không phải dễ nuốt đâu.

Sao em thử mà cũng giống như cũ vậy anh!

Có sửa lại mã số cột D mà module không báo gì hết! Vẫn thực hiện copy..
 
Upvote 0
Sao em thử mà cũng giống như cũ vậy anh!

Có sửa lại mã số cột D mà module không báo gì hết! Vẫn thực hiện copy..
Giống sao được mà giống. Bạn thử sửa mã số HS cho sai đi rồi xoá dữ liệu của hàng đó xem coi code nó có copy vào dòng đó hay không? Mình có viết dòng thông báo nào đâu mà thông báo chứ. Thêm dòng Else vào nhé.
PHP:
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                   Else
                     Msgbox "khong tim thay ma so: " & Res(i,1)
                  End If
 
Upvote 0
Giống sao được mà giống. Bạn thử sửa mã số HS cho sai đi rồi xoá dữ liệu của hàng đó xem coi code nó có copy vào dòng đó hay không? Mình có viết dòng thông báo nào đâu mà thông báo chứ. Thêm dòng Else vào nhé.
PHP:
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                   Else
                     Msgbox "khong tim thay ma so: " & Res(i,1)
                  End If

Nó hiện lên thông báo và đứng luôn! Không biết em có chép sai chỗ nào không?

Untitled.jpg

Không rõ thì anh xem tại đây nhé! (post hình kích thước bao nhiêu nhỉ?!)

Mã:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh As Worksheet, Res(), Data()
Dim HK, Lop, Mon, i As Long, j As Long, x As Byte
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
         With TH.Sheets(sh.Name)
            Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(Res)
               For j = 1 To UBound(Data)
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                     Else
                     MsgBox "khong tim thay ma so: " & Res(i, 1)
                  End If
               Next
            Next
            .[D6].Resize(i - 1, 30) = Res
         End With
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nó hiện lên thông báo và đứng luôn! Không biết em có chép sai chỗ nào không?
Thì khi xuất hiện thông báo cứ bấm Enter code sẽ chạy tiếp
Mà mã số xuất hiện trên màn hình có đúng là mã số đã cố tình làm cho sai hay không? Nếu đúng thì là code chạy tôt rồi
 
Lần chỉnh sửa cuối:
Upvote 0
Thì khi xuất hiện thông báo cứ bấm Enter code sẽ chạy tiếp
Mà mã số xuất hiện trên màn hình có đúng là mã số đã cố tình làm cho sai hay không? Nếu đúng thì là code chạy tôt rồi

Mình tải file về làm thử cũng bị đứng (Không làm gì đc trong Excel nữa)!

Màn hình hiện chỉ một mã bị làm sai thôi! Không hiện mã thứ hai!
 
Upvote 0
Thì mình cũng muốn nói như vậy nhưng không rõ ràng bàng bạn thôi...
Thử thế này xem sao
Mã:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh As Worksheet, Res(), Data()
Dim HK, Lop, Mon, i As Long, j As Long, x As Byte, loi As String, timloi
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
         With TH.Sheets(sh.Name)
            Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(Res)
               For j = 1 To UBound(Data)
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                  End If
               Next
               Set timloi = sh.[D:D].Find(Res(i, 1), , , 1)
               If timloi Is Nothing Then loi = loi & vbLf & Res(i, 1)
            Next
            .[D6].Resize(i - 1, 30) = Res
         End With
      End If
      If loi <> "" Then loi = sh.Name & vbLf & loi
   Next
   
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
If loi <> "" Then MsgBox "Co loi trong sheet " & vbLf & Replace(loi, vbLf, "", 1, 1)
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bị bo xịt là sao anh? Hai lúa mà.. Thông cảm
Em để hình là suy nghĩ nhức đầu như búa bổ và đổ mồ hôi chứ!!
Vậy là topic này cũng có nhiều cao thủ theo dõi, ae ăn nói cẩn thận..--=0
Tất cả các topic đều được mọi người quan tâm để hỗ trợ. Tại vì câu nói lấp lửng của bạn nên chính mình cũng thắc mắc không biết code ổn chưa.
 
Upvote 0
Tất cả các topic đều được mọi người quan tâm để hỗ trợ. Tại vì câu nói lấp lửng của bạn nên chính mình cũng thắc mắc không biết code ổn chưa.

Vậy thì mình đính chính lại!

Code của anh Hải chạy rất tốt! Hơn cả sự mong đợi của mình!

tại em muốn sửa lại chút cho phù hợp hơn với công việc của em nên nhức đầu thôi (không biết sửa như thế nào)!

Nếu được anh H và anh em trên diễn dàn sửa lại cho em như sau:

- Kiểm tra lại danh sách HS trước khi copy

+ Nếu đúng thì thực hiện copy vùng điểm thôi (giống như code lần trước đã làm)

+ Nếu sai thì chỉ ra chỗ sai (vd: số thứ tự mà HS bị sai tên) và không thực hiện copy bảng điểm đó!

anh em giúp mình nhé!
 
Upvote 0
Vậy thì mình đính chính lại!

Code của anh Hải chạy rất tốt! Hơn cả sự mong đợi của mình!

tại em muốn sửa lại chút cho phù hợp hơn với công việc của em nên nhức đầu thôi (không biết sửa như thế nào)!

Nếu được anh H và anh em trên diễn dàn sửa lại cho em như sau:

- Kiểm tra lại danh sách HS trước khi copy

+ Nếu đúng thì thực hiện copy vùng điểm thôi (giống như code lần trước đã làm)

+ Nếu sai thì chỉ ra chỗ sai (vd: số thứ tự mà HS bị sai tên) và không thực hiện copy bảng điểm đó!

anh em giúp mình nhé!

Code mình viết đã đầy đủ yêu cầu của bạn rồi đấy. Vùng sai đương nhiên là không copy. Có lẻ bạn không kiểm tra và thử thay đổi dữ liệu để biết kết quả của code
 
Upvote 0
Code mình viết đã đầy đủ yêu cầu của bạn rồi đấy. Vùng sai đương nhiên là không copy. Có lẻ bạn không kiểm tra và thử thay đổi dữ liệu để biết kết quả của code

Em kiểm tra và thử lại nhiều lần rồi!

Ý của em là: nếu danh sách của File môn Toán chỉ cần sai tên một HS so với File tổng hợp thì chỉ ra số thứ tự mà HS bị sai tên và không thực hiện copy toàn bộ môn Toán của cả lớp luôn!
 
Upvote 0
Em kiểm tra và thử lại nhiều lần rồi!

Ý của em là: nếu danh sách của File môn Toán chỉ cần sai tên một HS so với File tổng hợp thì chỉ ra số thứ tự mà HS bị sai tên và không thực hiện copy toàn bộ môn Toán của cả lớp luôn!
Chắc là code này được rồi đấy. Khuyến mãi thêm cái tô màu tại dòng có dữ liệu không trùng khớp
Mã:
Sub copy_lop()
Dim TH As Workbook, FileToOpen As Workbook, sh As Worksheet, Res(), Data()
Dim HK, Lop, Mon, i As Long, j As Long, x As Byte, loi As String, timloi
With Workbooks("tao module copy.xls").Sheets("sheet1")
   HK = .[a5]: Mon = .[C5]: Lop = .[B5]
End With
Set TH = Workbooks.Open(ThisWorkbook.Path & "\Tong hop diem HK" & HK & " " & Lop & ".xls")
Set FileToOpen = Workbooks.Open(ThisWorkbook.Path & "\" & Mon & " " & Lop & ".xls")
With FileToOpen
   For Each sh In .Worksheets
      If sh.UsedRange.Count > 0 Then
         Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
         With TH.Sheets(sh.Name)
            Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
            For i = 1 To UBound(Res)
               Set timloi = sh.[D:D].Find(Res(i, 1), , , 1)
               If timloi Is Nothing Then
                  FileToOpen.Sheets(sh.Name).Cells(i + 5, 4).Interior.ColorIndex = 6
                  MsgBox "Phat hien loi trong sheet " & sh.Name & vbLf & "Ma " & Res(i, 1) & vbLf & "Tai dòng " & i + 5
                  Exit Sub
               End If
            Next
            For i = 1 To UBound(Res)
               For j = 1 To UBound(Data)
                  If Res(i, 1) = Data(j, 1) Then
                     For x = 2 To 30
                        Res(i, x) = Data(j, x)
                     Next
                  End If
               Next
            Next
            .[D6].Resize(i - 1, 30) = Res
         End With
      End If
   Next
   .Close False
End With
TH.Close True
MsgBox "Da Copy Sheet " & Mon & Space(1) & "Tu Lop " & Lop
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn anh! Code chạy rất tốt và đáp ứng hết các yêu cầu.
 
Upvote 0
Năm hết, tết đến! Mình xin cảm ơn các bạn, các anh chị đã giúp đỡ, ủng hộ mình!

Xin chúc các bạn các anh chị trong diễn đàn năm mới thật nhiều hạnh phúc, thật nhiều niềm vui và có thêm thật nhiều thành viên nhiệt tình hơn nữa!
 
Upvote 0
Nếu bạn sử dụng 1 sheet chứa danh sách nhiều lớp (1 khối) như: 6a, 6b, 6c...và sử dụng mã lớp ở cột phụ nào đó để quản lý bằng lệnh AutoFilter thì đơn giản và hiệu quả hơn nhiều. Lúc đó sử dụng mã học sinh làm khoá chính để cập nhật ( dùng hàm Vlookup chẳng hạn) từ mẫu chi tiết sang mẫu tổng hợp cũng khá đơn giản và nhanh hơn nhiều như bạn đã từng làm. Nên tận dụng chức năng filter, soft để nâng cao hiệu quả quản lý. Tôi cũng tự mày mò thôi, trình độ ko cao nên cũng chỉ tìm ra được phương pháp đó, còn viết code thì tôi chưa biết. chúc bạn thành công

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu bạn sử dụng 1 sheet chứa danh sách nhiều lớp (1 khối) như: 6a, 6b, 6c...và sử dụng mã lớp ở cột phụ nào đó để quản lý bằng lệnh AutoFilter thì đơn giản và hiệu quả hơn nhiều. Lúc đó sử dụng mã học sinh làm khoá chính để cập nhật ( dùng hàm Vlookup chẳng hạn) từ mẫu chi tiết sang mẫu tổng hợp cũng khá đơn giản và nhanh hơn nhiều như bạn đã từng làm. Nên tận dụng chức năng filter, soft để nâng cao hiệu quả quản lý. Tôi cũng tự mày mò thôi, trình độ ko cao nên cũng chỉ tìm ra được phương pháp đó, còn viết code thì tôi chưa biết. chúc bạn thành công

Bạn nói mình chưa hiểu lắm! Bạn có thể đưa lên một bản để minh họa được không?

Còn theo nhu cầu công việc của mình thì mình thấy viết code hiệu quả hơn nhiều..tuy hơi khó!
 
Upvote 0
Giúp mình làm ngược lại :
- Có nhiều file tổng hợp điểm theo từng ngành
- Copy từ file tổng hợp điểm ( mỗi sheet là một môn học ) ra thành từng file excel theo mẫu có sẵn; copy lại từ đầu, tên danh sách sinh viên có thể thay đổi và đặt tên file theo : Nganh - Ten mon - HK - Nam
Thanks !
 

File đính kèm

Upvote 0
Giúp mình làm ngược lại :
- Có nhiều file tổng hợp điểm theo từng ngành
- Copy từ file tổng hợp điểm ( mỗi sheet là một môn học ) ra thành từng file excel theo mẫu có sẵn; copy lại từ đầu, tên danh sách sinh viên có thể thay đổi và đặt tên file theo : Nganh - Ten mon - HK - Nam
Thanks !

Bạn nói chưa rõ lắm! Và bạn nên chuyển file XLSX sang file XLS để anh em dễ xem hơn..(còn các Pro thì khỏi..)

Bạn ghi rõ hơn để các anh chị trong forum giúp bạn..
 
Upvote 0
Mình có file tổng hợp có đặc điểm : mỗi sheet là một môn học, danh sách sinh viên có thể thay đổi.
Mình muốn tạo một Module copy từ mỗi sheet của file tổng hợp thành nhiều file, mỗi file là một môn học riêng.
File tạo ra có mẫu sẵn, chỉ cần copy từ mỗi sheet danh sách và điểm thôi.
 
Upvote 0
Mình có file tổng hợp có đặc điểm : mỗi sheet là một môn học, danh sách sinh viên có thể thay đổi.
Mình muốn tạo một Module copy từ mỗi sheet của file tổng hợp thành nhiều file, mỗi file là một môn học riêng.
File tạo ra có mẫu sẵn, chỉ cần copy từ mỗi sheet danh sách và điểm thôi.
Mình nghĩ tốt nhất là tạo chủ đề mới đi bạn. Vấn đề của bạn đơn giản mà.
 
Upvote 0
gán dữ liệu từ 1 cột, nhiều cột sang1 cột (nhiều cột) ỏ sheet khác theo hàng ngang

Kính gửi các anh chị trên diễn đàn GPE!
Tôi muốn tổng hơp Nhập và Xuất LTTP hàng ngày để tính lượng tồn kho cuối mỗi ngày (sẽ tự dộng hiện ở cột D và E). Nếu copy sang thi dũ liệu của ngày hôm trước lại không tồn tại. Do trang NX LTTP hàng ngày là trang tính toán (chi có 1 trang này thôi-số liệu tự động tính toán khi đánh số ngày và quân số ăn). kiến thức về VBA và tiếng Anh của tôi hoàn toàn là " L-T-M". Mong các anh chị trên diễn dàn viết code giúp. Trân trọng cảm ơn nhiều!
Các yêu cầu tôi đã viết trong file đính kèm. Máy tôi dùng excel 2003
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
em cũng đang có một chủ đề tương tự như thế, nhưng đọc code không hiểu đoạn:

If sh.UsedRange.Count > 0 Then
Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
With TH.Sheets(sh.Name)
Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
For i = 1 To UBound(Res)


Mong bác quanghải và các a/c giải thích giúp e với.
 
Upvote 0
em cũng đang có một chủ đề tương tự như thế, nhưng đọc code không hiểu đoạn:

If sh.UsedRange.Count > 0 Then
Data = sh.Range(sh.[D6], sh.[D65536].End(3)).Resize(, 30).Value
With TH.Sheets(sh.Name)
Res = .Range(.[D6], .[D65536].End(3)).Resize(, 30).Value
For i = 1 To UBound(Res)


Mong bác quanghải và các a/c giải thích giúp e với.
Nếu dữ liệu trên Sheet lớn hơn 0 thì lấy vùng D6:D65536 kéo qua phải 30 cột.....
 
Upvote 0
sao lai kéo qua phải 30 cột để làm gì vậy bác?
đáng lẽ phải copy đến cột 30 thôi chứ nhir?
 
Upvote 0
sao lai kéo qua phải 30 cột để làm gì vậy bác?
đáng lẽ phải copy đến cột 30 thôi chứ nhir?
đó là vùng dữ liệu đưa vào code..... code đó thuộc dạng cao cấp rồi... Bạn mới Tập VBA thì tìm hiểu thuộc tính Range, Offset, Resize,... khi hiểu hết mớ đó thì bạn mới hiểu code đó được.... giải thích mình kém lắm ....mà mình mò học code ko thôi nên giải thích thuật ngữ hông trúng thì mấy học hành chính quy hahaha ...ngại ghê.....--=0--=0--=0
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom