Chép dữ liệu từ 2 workbook khác nhau

trantuonganh2008 · 3/12/09

Chào mọi người, Mình có 2 workbook đính kèm, nhờ các bạn giúp mình nhé. Cám ơn mọi người trước!!!

yeuthamhangxom · 3/12/09

trantuonganh2008 đã viết:
Chào mọi người,
Mình có 2 workbook đính kèm, nhờ các bạn giúp mình nhé.
Cám ơn mọi người trước!!!

Nếu chỉ lấy những dòng từ cột A đến cột K thì có thể dùng chức năng Data/Import External Data là được còn nếu theo cả điều kiện là LẤY TỪ DÒNG NÀY CHO ĐẾN KHI CỘT O CÓ SỐ ÂM XUẤT HIỆN LẦN ÁP CHÓT thì có lẽ phải dùng VBA.
Không biết có cao thủ nào biết cách khác không.
Chúc cả nhà vui vẻ.

trantuonganh2008 · 3/12/09

yeuthamhangxom đã viết:
Nếu chỉ lấy những dòng từ cột A đến cột K thì có thể dùng chức năng Data/Import External Data là được còn nếu theo cả điều kiện là LẤY TỪ DÒNG NÀY CHO ĐẾN KHI CỘT O CÓ SỐ ÂM XUẤT HIỆN LẦN ÁP CHÓT thì có lẽ phải dùng VBA. Không biết có cao thủ nào biết cách khác không. Chúc cả nhà vui vẻ.

Đúng vậy, mình nghĩ cái khó ở đây là làm sao nhận biết được số âm xuất hiện lần thứ 2 & lần áp chót. Mình xin gợi ý như sau (nếu cách trên không làm đựơc): - Chép những dòng (từ cột A đến K) với đk ở cột O có giá trị âm xuất hiện lần đầu tiên sau số 0 (có nghĩa là mình đã nhận dạng được số 0 xuất hiện lần sau cùng) & chép những dòng từ đây cho đến cuối tháng (có nghĩa là tại cột A không có ngày thì không chép nữa). Như vậy mình đã nhận biết được số 0 xuất hiện lần cuối cùng & ngày tháng tại cột A. Hoặc các bạn có thể thêm cột phụ cũng được & dĩ nhiên là phải dùng VBA thôi. Nhờ các bạn giúp mình nhé! Cám ơn nhiều!!!

nghiaphuc · 3/12/09

trantuonganh2008 đã viết:
Chào mọi người,
Mình có 2 workbook đính kèm, nhờ các bạn giúp mình nhé.
Cám ơn mọi người trước!!!

Bạn thử file này xem.
Sửa một xíu:
- Thay câu lệnh này

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

bởi câu lệnh sau cho gọn.

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues

- Để giữ định dạng ở file Book2 như file Book1, bạn thêm câu lệnh này

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteFormats

vào trước câu

PHP:

Next Sh

trantuonganh2008 · 3/12/09

Trên cả tuyệt vời. Cám ơn nghiaphuc nhiều. Bây giờ mình muốn chạy code một lần thôi thì tự động các sheet ở wb1 sang các sheet ở wb2 thì sửa code lại như thế nào? Cám ơn bạn nhiều nha!

trantuonganh2008 · 3/12/09

nghiaphuc đã viết:
Bạn thử file này xem. Sửa một xíu: - Thay câu lệnh này

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False

bởi câu lệnh sau cho gọn.

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues

- Để giữ định dạng ở file Book2 như file Book1, bạn thêm câu lệnh này

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteFormats

vào trước câu

PHP:

Next Sh

Cho mình hỏi thêm, bây giờ mình muốn chép dữ liệu ở sheet 1 của wb1 sang sheet 1 ở wb2 nhưng dữ liệu ở sheet 1 (wb1) nhiều dòng hơn sheet 1 (wb2). Có nghĩa là sheet 1 ở wb2 đã có dữ liệu sẵn (từ cột A đến K), mình muốn khi chép qua thì nó tự động insert dòng chứ không chép đè lên thì sửa đoạn code trên lại như thế nào? MOng các bạn chỉ giúp. Cám ơn nhiều!!!

nghiaphuc · 4/12/09

trantuonganh2008 đã viết:
Cho mình hỏi thêm, bây giờ mình muốn chép dữ liệu ở sheet 1 của wb1 sang sheet 1 ở wb2 nhưng dữ liệu ở sheet 1 (wb1) nhiều dòng hơn sheet 1 (wb2). Có nghĩa là sheet 1 ở wb2 đã có dữ liệu sẵn (từ cột A đến K), mình muốn khi chép qua thì nó tự động insert dòng chứ không chép đè lên thì sửa đoạn code trên lại như thế nào? MOng các bạn chỉ giúp. Cám ơn nhiều!!!

Nếu bạn muốn dữ liệu mới được chèn vào ô A6 còn các dữ liệu hiện có sẽ đẩy xuống phía dưới thì thay 2 câu lệnh

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues
Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteFormats

bởi 2 câu lệnh

PHP:

Wb2.Sheets(Sh.Name).Range("A6").Insert Shift:=xlDown
Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues

Còn nếu muốn dữ liệu mới nằm phía dưới dữ liệu cũ thì thêm 1 biến Hang kiểu Long và thay 2 câu lệnh trên bởi 4 câu lệnh sau:

PHP:

Hang = Wb2.Sheets(Sh.Name).Range("A65536").End(xlUp).Row + 1
If Hang < 6 Then Hang = 6
Wb2.Sheets(Sh.Name).Range("A" & Hang).PasteSpecial Paste:=xlPasteValues
Wb2.Sheets(Sh.Name).Range("A" & Hang).PasteSpecial Paste:=xlPasteFormats

Cũng cần nói thêm là nếu tại cột O có từ 2 số âm trở xuống thì sẽ có Cuoi < Dau. Do đó, kết quả sẽ không đúng. Để khắc phục điều này, hãy thêm câu lệnh

PHP:

If Cuoi < Dau Then Exit Sub

vào trước câu lệnh

PHP:

Sh.Range("A" & Dau & ":K" & Cuoi).Copy

trantuonganh2008 · 5/12/09

Cám ơn bạn nhiều. Phiền bạn tí nữa là mình muốn dữ liệu mới & dữ liệu cũ nằm sát nhau. VD: tại sheet 1(wb2) đã có dl tại A9, mà dl muốn chép qua có 6 dòng ===> dl chép qua nằm từ A6 đến A11. Bây giờ mình muốn dl tại A9 sẽ dịch chuyển xuống A12 (có nghĩa là giữa 2 dl cũ & mới sẽ không có một dòng trống nào). Nhờ bạn chỉ giúp nhé, cám ơn bạn một lần nữa!!!

trantuonganh2008 · 5/12/09

Nhờ bạn nghiaphuc giúp mình yêu cầu trên nhé. Cám ơn bạn nhiều!

nghiaphuc · 6/12/09

trantuonganh2008 đã viết:
Cám ơn bạn nhiều. Phiền bạn tí nữa là mình muốn dữ liệu mới & dữ liệu cũ nằm sát nhau.
VD: tại sheet 1(wb2) đã có dl tại A9, mà dl muốn chép qua có 6 dòng ===> dl chép qua nằm từ A6 đến A11. Bây giờ mình muốn dl tại A9 sẽ dịch chuyển xuống A12 (có nghĩa là giữa 2 dl cũ & mới sẽ không có một dòng trống nào). Nhờ bạn chỉ giúp nhé, cám ơn bạn một lần nữa!!!

Ý bạn là ở Wb2, ban đầu đã có dữ liệu nhưng không phải bắt đầu từ A6? Như vậy thì bạn thêm các câu lệnh

PHP:

Wb2.Sheets(Sh.Name).[A6].EntireRow.Insert
Wb2.Sheets(Sh.Name).[A6:A100].AutoFilter Field:=1, Criteria1:="="
Wb2.Sheets(Sh.Name).[A6:A65536].EntireRow.Delete

vào sau 2 câu lệnh

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues
Wb2.Sheets(Sh.Name).Range("A6").Insert Shift:=xlDown

(ý tưởng là sử dụng AutoFilter để lọc bỏ dòng trống, việc này cũng xử lý luôn vấn đề dữ liệu ban đầu ở Wb2 có nhiều nhưng không liên tục)
Mình đã sửa trong file đính kèm sau theo hướng giản lược những gì có thể (VD: thay Range("A6") bởi [A6])
Trong Sub Copy_Data có 3 dãy lệnh ứng với 3 trường hợp: DL mới nằm phía dưới DL cũ, DL mới nằm phía trên DL cũ (chèn dòng) và DL mới đè lên dữ liệu cũ. Cuối mỗi câu lệnh, mình đã chú thích rất rõ ràng. Bạn thêm hay xóa các dấu ' vào đầu các câu lệnh để sử dụng các câu lệnh cho phù hợp với yêu cầu.
Góp ý 1 xíu: Bạn nên sử dụng chức năng Record Macro của Excel và chức năng Help của VBA. Cứ cho nó Record Macro, và bạn làm các thao tác theo ý bạn => xem Code được tạo ra là gì, chỗ nào không biết cứ sử dụng chức năng Help của VBA, bạn sẽ tự học được rất nhiều (mình cũng bắt đầu với VBA bằng cách này chứ mình chẳng được học một chút gì về VB hay VBA cả)
Chúc thành công!

trantuonganh2008 · 8/12/09

Gửi nghiaphuc, Cho mình hỏi thêm chút nữa nhé, mình muốn chỉ lấy sheet1 & sheet3 của workbook1 qua thôi thì đặt lại đk như thế nào (có nghĩa là không muốn chép sheet2 qua thì đặt đk như thế nào?) Cám ơn nghiaphuc nhiều!!!

trantuonganh2008 · 8/12/09

Nhờ bạn nghiaphuc giúp mình bài này nhé! Thanks a lot!!!

trantuonganh2008 · 8/12/09

nghiaphuc đã viết:
Ý bạn là ở Wb2, ban đầu đã có dữ liệu nhưng không phải bắt đầu từ A6? Như vậy thì bạn thêm các câu lệnh

PHP:

Wb2.Sheets(Sh.Name).[A6].EntireRow.Insert Wb2.Sheets(Sh.Name).[A6:A100].AutoFilter Field:=1, Criteria1:="=" Wb2.Sheets(Sh.Name).[A6:A65536].EntireRow.Delete

vào sau 2 câu lệnh

PHP:

Wb2.Sheets(Sh.Name).Range("A6").PasteSpecial Paste:=xlPasteValues Wb2.Sheets(Sh.Name).Range("A6").Insert Shift:=xlDown

(ý tưởng là sử dụng AutoFilter để lọc bỏ dòng trống, việc này cũng xử lý luôn vấn đề dữ liệu ban đầu ở Wb2 có nhiều nhưng không liên tục) Mình đã sửa trong file đính kèm sau theo hướng giản lược những gì có thể (VD: thay Range("A6") bởi [A6]) Trong Sub Copy_Data có 3 dãy lệnh ứng với 3 trường hợp: DL mới nằm phía dưới DL cũ, DL mới nằm phía trên DL cũ (chèn dòng) và DL mới đè lên dữ liệu cũ. Cuối mỗi câu lệnh, mình đã chú thích rất rõ ràng. Bạn thêm hay xóa các dấu ' vào đầu các câu lệnh để sử dụng các câu lệnh cho phù hợp với yêu cầu. Góp ý 1 xíu: Bạn nên sử dụng chức năng Record Macro của Excel và chức năng Help của VBA. Cứ cho nó Record Macro, và bạn làm các thao tác theo ý bạn => xem Code được tạo ra là gì, chỗ nào không biết cứ sử dụng chức năng Help của VBA, bạn sẽ tự học được rất nhiều (mình cũng bắt đầu với VBA bằng cách này chứ mình chẳng được học một chút gì về VB hay VBA cả) Chúc thành công!

Xin chào nghiaphuc Mình hỏi bạn chút xíu, bây giờ mình không muốn chép sheet2 qua mà chỉ chép sheet1 & sheet3 thì đặt điều kiện như thế nào

nghiaphuc · 8/12/09

Rất đơn giản: Bạn chỉ cần thêm câu lệnh

PHP:

If Sh.Name = "Sheet2" Then GoTo NextSheet

vào sau câu

PHP:

For Each Sh In Wb1.Worksheets

và thêm nhãn

PHP:

NextSheet:

vào trước câu

PHP:

Next Sh

trantuonganh2008 · 8/12/09

Vậy nếu thêm sheet3 không muốn chép nữa thì có phải như vầy không bạn: If Sh.Name = "Sheet2 & ":" & sheet3"

nghiaphuc · 8/12/09

trantuonganh2008 đã viết:
Vậy nếu thêm sheet3 không muốn chép nữa thì có phải như vầy không bạn:
If Sh.Name = "Sheet2 & ":" & sheet3"

Vậy không ổn đâu bạn ơi.
Bạn có thể thay bởi câu lệnh:

PHP:

If (Sh.Name="Sheet2") Or (Sh.Name="Sheet3") Then Goto NextSheet

Còn nếu muốn bỏ qua nhiều Sheet hơn nữa thì có thể dùng hằng Bo và hàm Instr như ở bài trước mà bạn đã hỏi. Cụ thể lúc đó là:

PHP:

If Instr(Bo,Sh.Name)<>0 Then Goto NextSheet

trantuonganh2008 · 8/12/09

Ồ, mình hiểu rồi! Không biết nói gì hơn, xin cảm ơn bạn rất nhiều!!!

Chép dữ liệu từ 2 workbook khác nhau

Thành viên thường trực

File đính kèm

Thành viên tiêu biểu

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Facebook

Group